home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_vw.lha / st80_vw / TreeLW1.1 < prev   
Text File  |  1993-07-24  |  172KB  |  5,325 lines

  1. "       NAME            TreeLW1.1
  2.         AUTHOR          bruce@utafll.uta.edu (Bruce Samuelson)
  3.         FUNCTION        hierarchical tree structures; reusable class tester
  4.         ST-VERSIONS     ParcPlace VisualWorks 1.0 and ObjectWorks 4.1
  5.         PREREQUISITES   none
  6.         CONFLICTS       none
  7.         DISTRIBUTION    world
  8.         VERSION         1.1
  9.         DATE            July 16, 1993
  10.  
  11. SUMMARY The filein includes 13 classes implementing trees, a test
  12. drive class, a suite of tree tester classes, and several utility
  13. methods added to Object, Collection, etc. The tree classes resemble
  14. collection classes in their support for storage, retrieval, and
  15. enumeration. The design goals are robustness, flexibility,
  16. reusability, and reasonable efficiency in space and time. All the
  17. classes and nearly all the methods are commented. Several examples are
  18. included. The test driver can be reused to test similar applications.
  19. Class names and some method names are suffixed with 'LW' to reduce the
  20. chance of name clashes with other people's work. It stands for the
  21. author's Linguist's Workbench project. An article titled "Coping with
  22. Single Inheritance: Building Tree Classes" is expected to appear in
  23. the September or October 1993 issue of The Smalltalk Report."!
  24.  
  25. 'From VisualWorks(TM), Release 1.0 of 8 October 1992 on 5 July 1993 at 3:10:22 pm'!
  26.  
  27. Object subclass: #TreeLW
  28.     instanceVariableNames: ''
  29.     classVariableNames: 'BadKeySignal BadPathSignal BadSubTreesSignal BadValueSignal IncompatibleTreeSignal KeyNotFoundSignal NotATreeSignal TreeNotFoundSignal '
  30.     poolDictionaries: ''
  31.     category: 'Public Domain-Trees'!
  32. TreeLW comment:
  33. '(A) PUBLIC DOMAIN FILEIN COMMENTS
  34.  
  35. An article on the Tree class hierarchy is scheduled to appear in the September or October 1993 issue of The Smalltalk Report.
  36.  
  37. Tree filein version 1.1. ''LW'' suffix in class name is explained under ''Naming conventions'' below.
  38.  
  39. Changes from version 1.0: Increase the flexibility of the tree inheritance hierarchy and the possibilities for subclassing it by making TreeLW an abstract class and making all instance variables optional. There are now more combinations of possible instance variables and therefore more subclasses. Update the test suite to relect these changes.
  40.  
  41. Copyright (c) 1993 by Bruce Samuelson. Released to the public domain. Permission is granted to place this in Smalltalk archives such as Illinois, Manchester, and ParcBench. For use with ParcPlace VisualWorks 1.0 and ObjectWorks 4.1.
  42.  
  43. The filein includes the following material:
  44.  
  45.     13 tree classes: TreeLW and 12 subclasses
  46.     2 testing classes: TesterLW and TesterForTreesLW
  47.     13 testing subclasses containing test suites for the 13 tree classes
  48.     supporting methods added to ParcPlace classes.
  49.  
  50. The filein represents work in progress. If you use it, send bug reports, suggestions, modifications, and additions to bruce@utafll.uta.edu (uta eff ell ell) or bruce@ling.uta.edu. If you modify it, please document who wrote which part.
  51.  
  52. Naming conventions: I am using this distasteful scheme until Smalltalk supports better name space partitioning. (1) Class names: I add the ''LW'' suffix to all my class names to reduce the risk of collisions with other people''s classes. It stands for Linguist''s Workbench, a set of linguistic tools I''m developing. (2) Method names: When I add a utility method to a standard ParcPlace class such as Object or String, I add the ''LW'' suffix to its name for the same reason. Exceptions are methods that need to be used polymorphically with ParcPlace methods, methods with binary selectors, and those which for aesthetic reasons would be too ugly with this suffix. (3) Protocol names: When I add a utility method to a ParcPlace class, I put the method in a protocol with an ''lw'' prefix (usually ''lw extensions''). This distinguishes it from ParcPlace methods. Although my browser includes tools for supporting these naming conventions, the fileout does not include the browser tools.
  53.  
  54. You''ll get a list of the ''lw...'' protocols when you file in the code. Keep track of this list for future reference. Next time you build a new image, you''ll need to file out these protocols. The classes containing these new protocols are: Array, Character, Collection, InternalStream, Object, OrderedCollection class, OrderedCollection, PositionableStream, SequenceableCollection class, SequenceableCollection, Set, SortedCollection, String class, String.
  55.  
  56. (B) NORMAL CLASS COMMENTS
  57.  
  58. TreeLW is an abstract class with no instance variables. It represents a hierarchical structure whose intermediate nodes are called branches and whose terminal nodes are called leaves.
  59.  
  60. TreeLW forms the root of an inheritance hierarchy for several tree classes. They are application neutral and are analogous to the upper levels of the Collection hierarchy. The design goal is that they be robust and flexible enough to be reusable in a range of applications, either directly or as anchors for application specific subclasses, and that they be reasonably efficient in space and time.
  61.  
  62. The strategies for achieving this goal are to (1) offer Tester classes that validate the methods in the tree classes, (2) validate selected arguments passed by clients of tree services, (3) place support for each service at the highest possible level in the inheritance hierarchy, (4) maximize polymorphic use of services, (5) minimize code duplication, (6) introduce instance variables at the lowest possible level in the hierarchy, (7) minimize direct access to instance variables, and (8) offer flexibility in the way subtrees are represented.
  63.  
  64. Most of these strategies are object oriented versions of motherhood and apple pie. However, it takes some discipline to apply them to the design of tree classes in Smalltalk. Trees as conceived here are most naturally represented by multiple inheritance while Smalltalk only supports single inheritance. Let''s consider each strategy in turn.
  65.  
  66. (1) Class validation suite
  67.  
  68. TreeLW and its subclasses can be validated by evaluating the code below and observing the results in the SystemTranscript. TesterForTreesLW is a common superclass for the tree validation suites. The suites contain examples of how to use trees properly and of programming errors. Their methods can be cross referenced using ''senders'' and ''implementors'' in the system browser.
  69.  
  70.     TesterForTreesLW new runAllSubclasses.
  71.  
  72. (2) Argument validation
  73.  
  74. When a tree client sends a message that creates or modifies a tree, its arguments get validated by methods in the ''private validating'' protocol. These catch most errors before they can cause trouble and provide a clearer explanation of the error than would be possible if it went undetected until later in the processing. Although the performance penalty is relatively modest, application subclasses may override the validations with no-ops if they need to minimize the penalty.
  75.  
  76. (3-5) High level, polymorphic services with minimal code duplication
  77.  
  78. Most methods are defined in TreeLW itself and do not need to be redefined by subclasses. This minimizes code duplication. An example is the definition of a tree''s root. If the tree maintains a superTree pointer, the root is obtained by following the pointer chain to the top node. If the tree does not maintain the pointer, it is by definition its own root node. It is not necessary to maintain one set of code for tree subclasses that define the pointer and another set for classes that do not.
  79.  
  80. Another example of services implemented at the top of the inheritance hierarchy is subTrees processing. SubTrees are accessed from a message send rather than from an instance variable. This enables support for services such as the traditional enumerating methods offered by collections. All that is required is that each tree class be able to respond to the subTrees selector.
  81.  
  82. Some instance variables, such as the superTree pointer and value variable, are introduced several times by different subclasses in the inheritance hierarchy. The only code that must be duplicated among these classes is the basic read and write methods in the ''private accessing'' protocol. Other instance variables such as ''subTrees'' and ''key'' introduce considerable functionality and need many methods to support their semantics. The inheritance hierarchy is arranged so that each of these is introduced in only one subclass. Their supporting methods therefore do not need to be duplicated in other subclasses.
  83.  
  84. (6-7) Introduction of and access to instance variables
  85.  
  86. These are introduced into the tree classes as follows. The classes marked as concrete/abstract can/cannot be instantiated because they do/do not define how to access subtrees or how to distinguish leaves from branches.
  87.  
  88. TreeLW ()   "abstract"
  89.     PTreeLW (''superTree'')   "abstract"
  90.         PVTreeLW (''value'')   "abstract"
  91.     STreeLW (''subTrees'')   "concrete"
  92.         SKTreeLW (''key'')   "concrete"
  93.             SKPTreeLW (''superTree'')   "concrete"
  94.                 SKPVTreeLW (''value'')   "concrete"
  95.             SKVTreeLW (''value'')   "concrete"
  96.         SPTreeLW (''superTree'')   "concrete"
  97.             SPVTreeLW (''value'')   "concrete"
  98.         SVTreeLW (''value'')   "concrete"
  99.     VTreeLW (''value'')   "abstract"
  100.         BinaryTreeLW (''left'' ''right'')   "concrete: defined for pedagogical purposes only"
  101.  
  102. Naming Convention
  103.  
  104. Prepend the first letter of each variable''s name to TreeLW. ''P'' designates superTree since ''S'' is already used to designate subTrees.
  105.  
  106. SubTrees and key are introduced in one class each, superTree in three classes, and value in six classes. Each is only introduced when needed, and all possible combinations are available for defining application specific subclasses. The exception is that there are no classes defining a key without subTrees because it would make no sense. The reason will become clear below.
  107.  
  108. Nil may not be stored in these variables. It is a reserved value returned by accessor methods to indicate that an instance variable has not been defined. For example, if superTree (has/has not) been defined, its accessor method will return a (non-nil/nil) value.
  109.  
  110. Here''s an explanation of the instance variables introduced by tree subclasses.
  111.  
  112. superTree
  113.  
  114. Trees that need to maintain pointers to their parent nodes do so by defining a superTree variable. Because this pointer is maintained automatically, there is no public method for setting it. Trees not needing this pointer do not define it. This saves the memory occupied by an instance variable. More significantly, when there is no superTree pointer, a single instance can be attached to and shared by several supertrees. This can save substantial memory in applications that have large numbers of trees with common substructure.
  115.  
  116. subTrees
  117.  
  118. This is a collection holding the immediate descendants of a node in the tree. Any hierarchical data structure must have a way to represent descendant nodes. In our scheme, a concrete tree class must either define subTrees as an explicit instance variable, or it must define other variables which serve the same purpose. BinaryTreeLW is an example of this alternate definition. Its class comment explains how it works. Classes not defining a subTrees variable or its equivalent are abstract. Subtrees are explained further in the next numbered section.
  119.  
  120. key, value
  121.  
  122. Data may be stored at a tree node in a key or a value. Key is used when the data is unique. It is analogous to a dictionary key in Smalltalk or to a unique key in a database. It forms the basis for traversing the tree. Value is used when the data is not unique and will not be used for traversal. A tree representing a file system is an example of a key based tree. Directories are branches and files are leaves. Within a directory, the name if each file and subdirectory is unique. These names can be used as keys. An example of a value based tree would be a parse tree representing the noun phrase ''a cold juicy apple.'' The values stored in its subTrees are lexical categories (article adjective adjective noun) and are not unique. It is also possible to define a tree class with both a key and a value. In representing a file system, the key could be the file''s name and the value its contents or attributes.
  123.  
  124. If an application uses trees with keys, i.e., SKTreeLW or a subclass, it is responsible for maintaining the keys'' uniqueness. Although SKTreeLW could be made to enforce it, there would be a performance penalty. The next section explains different ways to store subTrees. If the application uses a sequenceable collection, it must guarantee keys'' uniqueness. If it uses a set, uniqueness will be automatically guaranteed. In the comparison protocol for SKTreeLW, equality, precedence, and hash are based on the key alone. Subclasses should not redefine these to depend on other variables.
  125.  
  126. (8) Flexible representation of subtrees
  127.  
  128. Any scheme for defining a tree needs some way to represent its descendants. Two techniques are available. One may define either application specific instance variables holding the descendants or a subTrees variable holding an explicit collection. The first technique is illustrated in the BinaryTreeLW class, which is defined solely for illustrative purposes. The second technique is used in STreeLW and its subclasses.
  129.  
  130. A novel feature of STreeLW is that the client application may choose what kind of collection to use for holding subtrees. For STreeLW, some sequenceable collections are allowed. For SKTreeLW, Sets are also available. Browse implementors of validateSubTreesClass: for details. This method gives guidelines if you wish to create a new kind of collection class for holding subTrees.
  131.  
  132. In most applications, all the nodes in a tree will use the same kind of collection for storing subtrees, but this is not required. For example, it is possible for some nodes to use an ordered collection and for others to use a set. Highlight and inspect this legal code: "| t1 t2 | t1 := SKTreeLW key: 1 subTrees: OrderedCollection. t2 := SKTreeLW key: 2 subTrees: Set. t1 add: t2. t1".
  133.  
  134. It is also possible to mix instances of different tree classes. To be compatible they must both define a superTree pointer or both not define it. Highlight and inspect this legal code: "| t1 t2 | t1 := STreeLW new. t2 := SKTreeLW key: 2. t1 add: t2. t1". Highlight and evaluate this illegal code: "| t1 t2 | t1 := SPTreeLW new. t2 := SKTreeLW key: 2. t1 add: t2. t1".There is protocol for converting from one subtrees collection class to another and from one tree class to another.
  135.  
  136. Choosing a collection class may preclude the use of some methods in the accessing protocol. Trees built with sets cannot use atIndex: and atIndex:put:. Trees built with sorted collections cannot use atIndex:put:. Otherwise there are no restrictions. Trees built with arrays can use the adding and removing protocol even though arrays normally cannot.
  137.  
  138. By supporting a variety of collection classes for subtrees, STreeLW makes a typical Smalltalk tradeoff of increased flexibility at the expense of slightly decreased safety. This may offend the sensibilities of programmers who like strong typing.
  139.  
  140. Clients of a tree may communicate with its subtrees. For example,
  141.  
  142.     | tree subs last |
  143.     tree := (some code defining a tree).
  144.     subs := tree subTrees.
  145.     last := subs last.
  146.  
  147. Two warnings must be heeded when doing this: (1) The collection must be able to understand the message. For example, <Array last> makes sense but <Set last> does not. (2) Access messages that read from the collection, such as <subs last>, are acceptable. Access messages that write to it, such as <subs add:> are not, since this would bypass TreeLW''s validation and pointer management mechanisms.
  148.  
  149. TreeLW subclasses must provide a means to distinguish branch nodes from leaf nodes. STreeLW bases the distinction on the contents of the subTrees variable. Branches use a collection instance and leaves use a collection class. This technique has two advantages over representing leaves by an empty collection. It is more space efficient and it allows a branch to hold zero subtrees. This is analogous to an empty directory in a file system. The technique''s advantage over defining new classes to represent leaves is that it avoids a major proliferation of the class hierarchy.
  150.  
  151. (*) Final comments and warnings
  152.  
  153. Trees may not be cyclic, i.e., you may not store a tree as a direct or recursive subtree of itself. Clients of TreeLW are responsible for observing this constraint. If they do not, infinite recursion will occur for many operations. It would impact performance too much for TreeLW to enforce it.
  154.  
  155. Subclasses that add instance variables to TreeLW other than those listed below may need to redefine <TreeLW basicCopy:>. This is somewhat like redefining copyEmpty: for new collection subclasses.
  156.  
  157. Class Variables
  158.  
  159. several        <Signal>    There are several signals that get raised on error conditions.
  160.  
  161. Instance Variables introduced by subclasses (nil values are illegal as explained above)
  162.  
  163. subTrees    <Coll of trees        A collection instance (possibly empty) is used for a branch node.
  164.             or Coll class>        A collection class is used for a leaf node.
  165. superTree    <TreeLW | nontree>    A non tree value marks a root node.
  166. key            <Object>            Unique data stored at node; used for traversing tree.
  167. value        <Object>            Non unique data stored at node. May be used to supplement key.'!
  168.  
  169.  
  170. !TreeLW methodsFor: 'accessing simple'!
  171.  
  172. key
  173.     "Return the key if it is defined or nil otherwise."
  174.  
  175.     ^self basicKey!
  176.  
  177. key: aKey
  178.     "Validate the argument and, if the receiver defines a key, set it. Return the receiver."
  179.  
  180.     self validateKey: aKey.
  181.     self basicKey: aKey!
  182.  
  183. subTrees
  184.     "Return the subTrees. The basicSubTrees method explains the returned value."
  185.  
  186.     ^self basicSubTrees!
  187.  
  188. subTrees: subTreesColl 
  189.     "Validate the argument and set the subTrees to it. Return the receiver. The 
  190.     basicSubTrees: method explains the argument."
  191.  
  192.     self validateSubTrees: subTreesColl.
  193.     self definesSuperTree ifTrue: [self do: [:tree | tree makeRoot]].
  194.     self fastSubTrees: subTreesColl!
  195.  
  196. superTree
  197.     "Return the superTree if it is defined or nil otherwise."
  198.  
  199.     ^self basicSuperTree!
  200.  
  201. superTree: aTree 
  202.     "The superTree pointer, if defined by the receiver, is managed internally and is 
  203.     not modifiable by clients."
  204.  
  205.     self shouldNotImplement!
  206.  
  207. value
  208.     "Return the value if it is defined or nil otherwise."
  209.  
  210.     ^self basicValue!
  211.  
  212. value: anObject 
  213.     "Validate the argument and, if the receiver defines a value, set it. Return the receiver."
  214.  
  215.     self validateValue: anObject.
  216.     self basicValue: anObject! !
  217.  
  218. !TreeLW methodsFor: 'accessing misc'!
  219.  
  220. fullPathNodes
  221.     "Return an array containing nodes from the root to the receiver, inclusive of 
  222.     both. If the receiver is a root node, the array will contain the receiver as its 
  223.     single element."
  224.  
  225.     ^self isRoot
  226.         ifTrue: [Array with: self]
  227.         ifFalse: [self superTree fullPathNodes copyWith: self]!
  228.  
  229. root
  230.     "Return the root of the tree to which the receiver belongs, or the receiver itself if 
  231.     it does not have a superTree."
  232.  
  233.     ^self isRoot
  234.         ifTrue: [self]
  235.         ifFalse: [self superTree root]!
  236.  
  237. rootlessPathNodes
  238.     "Return an array containing nodes from the root to the receiver, excluding the 
  239.     root and including the receiver. If the receiver is a root node, the array will be 
  240.     empty."
  241.  
  242.     | fullPath |
  243.     fullPath := self fullPathNodes.
  244.     ^fullPath copyFrom: 2 to: fullPath size! !
  245.  
  246. !TreeLW methodsFor: 'comparing'!
  247.  
  248. = aTree 
  249.     "Answer whether the receiver is equal to aTree. 
  250.     
  251.     This method is defined here solely to provide the following comments. It is 
  252.     needed to support some includes: messages and, for subclasses storing 
  253.     subTrees, some remove: messages. Consider redefining it. Subclasses storing 
  254.     a key define it to support keyed access to their subTrees."
  255.  
  256.     ^super = aTree! !
  257.  
  258. !TreeLW methodsFor: 'copying'!
  259.  
  260. copy
  261.     "Return a copy of the receiver which shares no direct or recursive subtrees with it."
  262.  
  263.     ^self recursiveCopy!
  264.  
  265. recursiveCopy
  266.     "Return a copy of the receiver in which its direct and recursive subTrees are 
  267.     copied. No trees are shared between the receiver and its copy. If we were willing 
  268.     to coerce all the subtrees to be of the same tree class, we could implement this 
  269.     simply as 
  270.     
  271.     ^self recursiveAs: self species"
  272.  
  273.     | newTree |
  274.     newTree := self basicCopy: self species.
  275.     self isBranch ifTrue: [newTree fastSubTrees: (self subTrees collectLW: [:tree | tree recursiveCopy])].
  276.     ^newTree! !
  277.  
  278. !TreeLW methodsFor: 'testing simple'!
  279.  
  280. definesKey
  281.     "Does the receiver define a key?"
  282.  
  283.     ^self basicKey notNil!
  284.  
  285. definesSubTrees
  286.     "Does the receiver define subTrees? This method documents the requirement 
  287.     that subclasses must implement the basicSubTrees method. There is no reason 
  288.     for there to be any senders of definesSubTrees."
  289.  
  290.     ^true!
  291.  
  292. definesSuperTree
  293.     "Does the receiver define a superTree?"
  294.  
  295.     ^self basicSuperTree notNil!
  296.  
  297. definesValue
  298.     "Does the receiver define a value?"
  299.  
  300.     ^self basicValue notNil! !
  301.  
  302. !TreeLW methodsFor: 'testing misc'!
  303.  
  304. belongsTo: aTree 
  305.     "Return a boolean indicating whether aTree is the direct parent of 
  306.     the receiver."
  307.  
  308.     ^self superTree == aTree!
  309.  
  310. hasSubTrees
  311.     "Return a boolean indicating whether the receiver has at least one subtree."
  312.  
  313.     ^self subTrees size > 0!
  314.  
  315. includes: aTree 
  316.     "Return a boolean indicating whether aTree is a direct subtree of the receiver. 
  317.     Clients using this method must be satisfied with the definition of the equality 
  318.     test (=)"
  319.  
  320.     ^self subTrees includes: aTree!
  321.  
  322. includesTreeSatisfying: aBlock 
  323.     "Return a boolean indicating whether the receiver includes at least one direct 
  324.     subtree satisfying aBlock."
  325.  
  326.     ^(self detectLW: [:tree | aBlock value: tree]) notNil!
  327.  
  328. isBranch
  329.     "Return a boolean indicating whether the receiver is a branch node."
  330.  
  331.     ^self isLeaf not!
  332.  
  333. isLeaf
  334.     "Return a boolean indicating whether the receiver is a leaf node."
  335.  
  336.     self subclassResponsibility!
  337.  
  338. isProductive
  339.     "Return a boolean indicating whether the receiver is a leaf or includes a leaf in its 
  340.     direct or recursive subtrees."
  341.  
  342.     ^self isLeaf or: [self recursiveIncludesTreeSatisfying: [:tree | tree isLeaf]]!
  343.  
  344. isRoot
  345.     "Is the receiver a root node? In our scheme a tree is a root node if it does not 
  346.     define a superTree pointer or if the pointer it defines stores a non tree object."
  347.  
  348.     ^self superTree isTreeLW not!
  349.  
  350. isTreeLW
  351.     "Return a boolean indicating whether the receiver is a tree. The method name 
  352.     includes the LW suffix because it is also defined in Object."
  353.  
  354.     ^true!
  355.  
  356. recursiveBelongsTo: aTree 
  357.     "Return a boolean indicating whether aTree is the direct or recursive 
  358.     parent of the receiver."
  359.  
  360.     ^(self belongsTo: aTree) or: [self isRoot not and: [self superTree recursiveBelongsTo: aTree]]!
  361.  
  362. recursiveIncludes: aTree 
  363.     "Return a boolean indicating whether aTree is a direct or recursive subtree of the 
  364.     receiver. Clients using this method must be satisfied with the definition of the 
  365.     equality test (=)."
  366.  
  367.     ^self recursiveIncludesTreeSatisfying: [:tree | tree = aTree]!
  368.  
  369. recursiveIncludesTreeSatisfying: aBlock 
  370.     "Return a boolean indicating whether the receiver includes at least one direct 
  371.     or recursive subtree satisfying aBlock."
  372.  
  373.     ^(self
  374.         recursiveDetect: aBlock
  375.         inclusive: false
  376.         topDown: true
  377.         breadthFirst: true) notNil! !
  378.  
  379. !TreeLW methodsFor: 'enumerating'!
  380.  
  381. collectLW: aBlock 
  382.     "Return a recursive copy of the receiver whose direct subtrees have been 
  383.     transformed by evaluating aBlock on them. If the receiver is a leaf node, return 
  384.     a recursive copy of it. The method is named collectLW: because the PPS 
  385.     version 4.1 implementation of collect: is slightly flawed."
  386.  
  387.     | newTree |
  388.     newTree := self recursiveCopy.
  389.     self isBranch ifTrue: [newTree subTrees: (newTree subTrees collectLW: aBlock)].
  390.     ^newTree!
  391.  
  392. detectLW: aBlock 
  393.     "Return the first direct subtree of the receiver for which aBlock evaluates to 
  394.     true, or nil otherwise.The method is not named detect:, because that signals an 
  395.     error where we want to return nil."
  396.  
  397.     ^self subTrees detectLW: aBlock!
  398.  
  399. do: aBlock 
  400.     "Evaluate aBlock on the direct subTrees of the receiver. Return the receiver."
  401.  
  402.     self subTrees do: aBlock!
  403.  
  404. do: aBlock inclusive: boolean1 reOrder: boolean2 
  405.     "Evaluate aBlock on the receiver (if boolean1 is true) and on its direct subTrees. 
  406.     In addition, if boolean2 is true, make sure the subTrees are properly ordered. 
  407.     See TreeLW>>reOrderLW for explanation. Return the receiver."
  408.  
  409.     boolean1 ifTrue: [aBlock value: self].
  410.     self do: aBlock.
  411.     boolean2 ifTrue: [self reOrderLW]!
  412.  
  413. inclusiveDo: aBlock 
  414.     "Evaluate aBlock on the receiver and on its direct subTrees. Return the receiver."
  415.  
  416.     aBlock value: self.
  417.     self do: aBlock!
  418.  
  419. recursiveCollect: aBlock inclusive: boolean 
  420.     "Evaluate aBlock on basic copies of the recursive subtrees of the receiver, 
  421.     forming new subTrees collections from the results. The block is also evaluated 
  422.     on a basic copy of the receiver if boolean is true. Return the resulting tree."
  423.  
  424.     | newTree |
  425.     newTree := self basicCopy: self species.
  426.     boolean ifTrue: [newTree := aBlock value: newTree].
  427.     self isBranch ifTrue: [newTree subTrees: (self subTrees collectLW: [:subTree | subTree recursiveCollect: aBlock inclusive: true])].
  428.     ^newTree!
  429.  
  430. recursiveDetect: aBlock inclusive: incl topDown: tD breadthFirst: bF 
  431.     "Search recursively through the receiver, returning the first tree for which
  432.     aBlock, when evaluated on the tree, returns true. Return nil if none is found. 
  433.     
  434.     incl    <Boolean>        true: include the receiver in the search; false: do not include it 
  435.     tD    <Boolean>        true: traverse top down; false: traverse bottom up 
  436.     bF    <Boolean>        true: traverse breadth first; false: traverse depth first (see caveat) 
  437.     
  438.     Caveat: our implementation of bottom up depth first searches all sub nodes
  439.     of a node before searching the node. Programmers needing to search the
  440.     node before completing the search of all subnodes will have to write a
  441.     special purpose method.
  442.  
  443.     Note: A method in the test suite demonstrates the various tD bF ordering permutations.
  444.     Browse implementors of this method."
  445.  
  446.     incl ifTrue: [tD ifTrue: [(aBlock value: self) ifTrue: [^self]]].
  447.     self isBranch
  448.         ifTrue:
  449.             [| recurse break subs |
  450.             recurse := [:subTree :inc | subTree
  451.                         recursiveDetect: aBlock
  452.                         inclusive: inc
  453.                         topDown: tD
  454.                         breadthFirst: bF].
  455.             break := [:answer | answer isTreeLW ifTrue: [^answer]].
  456.             subs := self subTrees.
  457.             bF
  458.                 ifTrue: [tD
  459.                         ifTrue: 
  460.                             [break value: (subs detectLW: aBlock).
  461.                             subs do: [:sub | break value: (recurse value: sub value: false)]]
  462.                         ifFalse: 
  463.                             [subs do: [:sub | break value: (recurse value: sub value: false)].
  464.                             break value: (subs detectLW: aBlock)]]
  465.                 ifFalse: [subs do: [:sub | break value: (recurse value: sub value: true)]]].
  466.     incl ifTrue: [tD ifFalse: [(aBlock value: self) ifTrue: [^self]]].
  467.     ^nil!
  468.  
  469. recursiveDo: aBlock 
  470.     "Evaluate aBlock recursively on the receiver using default parameters. Return 
  471.     the receiver."
  472.  
  473.     self
  474.         recursiveDo: aBlock
  475.         inclusive: true
  476.         topDown: true
  477.         breadthFirst: true
  478.         reOrder: true!
  479.  
  480. recursiveDo: aBlock inclusive: incl topDown: tD breadthFirst: bF reOrder: reOrder 
  481.     "Evaluate aBlock recursively on the receiver and return the receiver.
  482.     
  483.     incl    <Boolean>        true: include the receiver in the evaluation; false: do not include it 
  484.     tD    <Boolean>        true: traverse top down; false: traverse bottom up 
  485.     bF    <Boolean>        true: traverse breadth first; false: traverse depth first (see caveat) 
  486.     reOrder    <Boolean>    true: reOrder all recursive subtree collections; false: do not reOrder 
  487.     
  488.     Caveat: our implementation of bottom up depth first operates on all sub nodes of a
  489.     node before operating on the node. Programmers needing to operate on the node
  490.     before operating on all subnodes will have to write a special purpose method.
  491.  
  492.     Note: a method in the test suite demonstrates the various tD bF ordering permutations.
  493.     Browse implementors of this method."
  494.  
  495.     incl ifTrue: [tD ifTrue: [aBlock value: self]].
  496.     self isBranch
  497.         ifTrue:
  498.             [| recurse subs |
  499.             recurse := [:subTree :inc | subTree
  500.                         recursiveDo: aBlock
  501.                         inclusive: inc
  502.                         topDown: tD
  503.                         breadthFirst: bF
  504.                         reOrder: reOrder].
  505.             subs := self subTrees.
  506.             bF
  507.                 ifTrue: [tD
  508.                         ifTrue: 
  509.                             [subs do: aBlock.
  510.                             subs do: [:sub | recurse value: sub value: false]]
  511.                         ifFalse: 
  512.                             [subs do: [:sub | recurse value: sub value: false].
  513.                             subs do: aBlock]]
  514.                 ifFalse: [subs do: [:sub | recurse value: sub value: true]]].
  515.     incl ifTrue: [tD ifFalse: [aBlock value: self]].
  516.     reOrder ifTrue: [self reOrderLW]!
  517.  
  518. recursiveSubTrees: inclusiveBoolean 
  519.     "Return an OrderedCollection of all nodes recursively in the receiver in top 
  520.     down, breadth first order. The receiver is included if inclusiveBoolean is true."
  521.  
  522.     | nodes |
  523.     nodes := OrderedCollection new.
  524.     self
  525.         recursiveDo: [:node | nodes add: node]
  526.         inclusive: inclusiveBoolean
  527.         topDown: true
  528.         breadthFirst: true
  529.         reOrder: false.
  530.     ^nodes! !
  531.  
  532. !TreeLW methodsFor: 'converting'!
  533.  
  534. as: treeClass 
  535.     "Return a recursive copy of the receiver which has been converted to be an 
  536.     instance of treeClass and whose direct and recursive subTrees remain 
  537.     instances of their original tree classes.
  538.  
  539.     Implementation note: We cannot use changeClassToThatOf: because the
  540.     conversion may reduce the number of instance variables. Also, we do not
  541.     want to change the receiver.
  542.     
  543.     WARNING: to convert between incompatible tree types, use recursiveAs:,
  544.     not as:. The validateTree: method tests for incompatibility."
  545.  
  546.     | newTree |
  547.     self validateTreeClass: treeClass.
  548.     newTree := self basicCopy: treeClass.
  549.     self validateTree: newTree.    "Protects against mixing incompatible trees."
  550.     self isBranch ifTrue: [newTree fastSubTrees: (self subTrees collectLW: [:tree | tree recursiveCopy])].
  551.     ^newTree!
  552.  
  553. recursiveAs: treeClass 
  554.     "Return an instance of treeClass like the receiver with its direct and recursive 
  555.     subtrees also converted to instances of treeClass. One may convert from any 
  556.     tree class to any other tree class this way. If the classes care about the 
  557.     number or order of their subTrees, these must be consistent. Classes with a 
  558.     subTrees variable defined do not care. Classes with it not defined do care."
  559.  
  560.     | newTree |
  561.     self validateTreeClass: treeClass.
  562.     newTree := self basicCopy: treeClass.
  563.     self isBranch ifTrue: [newTree fastSubTrees: (self subTrees collectLW: [:tree | tree recursiveAs: treeClass])].
  564.     ^newTree! !
  565.  
  566. !TreeLW methodsFor: 'printing simple'!
  567.  
  568. printOn: aStream 
  569.     "Print a hierarchical representation of the receiver on aStream."
  570.  
  571.     | printBlock |
  572.     printBlock := 
  573.             [:tree :indent | 
  574.             aStream cr.
  575.             aStream nextPutAll: indent.
  576.             aStream nextPutAll: (tree nodePrintString contractTo: 75) crsToSpacesLW.
  577.             tree do: [:subTree | printBlock value: subTree value: indent ,, self indentUnit]].
  578.     printBlock value: self value: String new! !
  579.  
  580. !TreeLW methodsFor: 'private initializing'!
  581.  
  582. defaultKey
  583.     "Return the default value for initializing the key."
  584.  
  585.     ^#UndefinedKey!
  586.  
  587. defaultSubTrees
  588.     "Return the default value for initializing the subTrees."
  589.  
  590.     self subclassResponsibility!
  591.  
  592. defaultSuperTree
  593.     "Return the default value for initializing the superTree."
  594.  
  595.     ^#none!
  596.  
  597. defaultValue
  598.     "Return the default value for initializing the value."
  599.  
  600.     ^#UndefinedValue!
  601.  
  602. initialize
  603.     "Initialize and return the receiver. Nil values may not be used. They are reserved 
  604.     for determining which instance variables have been defined. See the defines... 
  605.     suite of messages."
  606.  
  607.     self basicKey: self defaultKey.
  608.     self basicValue: self defaultValue.
  609.     self basicSubTrees: self defaultSubTrees.
  610.     self basicSuperTree: self defaultSuperTree! !
  611.  
  612. !TreeLW methodsFor: 'private accessing'!
  613.  
  614. basicKey
  615.     "Return the key if it is defined or nil otherwise."
  616.  
  617.     ^nil!
  618.  
  619. basicKey: aKey
  620.     "If the receiver defines key, set it. Return the receiver."!
  621.  
  622. basicSubTrees
  623.     "Return the subTrees. 
  624.     
  625.     This method must be implemented by subclasses. Those defining a subTrees 
  626.     variable will return it, possibly after doing some processing on it. Those not 
  627.     defining the variable will typically return an array containing those instance 
  628.     variables which store tree nodes. For example, a binary tree with <left> and 
  629.     <right> variables could implement it as ^<Array with: left with: right>."
  630.  
  631.     self subclassResponsibility!
  632.  
  633. basicSubTrees: subTreesColl 
  634.     "Set the subTrees to the argument and return the receiver. 
  635.     
  636.     This method must be implemented by subclasses. Those defining a subTrees 
  637.     variable will set it to subTreesColl. Those not defining the variable will set those 
  638.     instance variables that can store tree nodes to the elements of subTreesColl. 
  639.     For example, a binary tree with <left> and <right> variables could implement it 
  640.     roughly as self left: (subTreesColl at: 1); right: (subTreesColl at: 2). See
  641.     implementors for details.
  642.     
  643.     The criteria that subTreesColl must satisfy depend on which TreeLW subclass
  644.     implements the method:
  645.     
  646.     1) If the tree subclass does not define a subTrees variable, the argument must 
  647.     be an instance of a sequenceable collection subclass whose size equals the 
  648.     number of instance variables storing tree nodes (for branches) or zero (for
  649.     leaves). In the example above for BinaryTreeLW, the size is two.
  650.     
  651.     2) If the tree subclass defines a subTrees variable but no key variable, the 
  652.     argument must be a sequenceable collection subclass or an instance of such a 
  653.     subclass. For example, it may be the Array class or an Array instance holding 
  654.     three trees. 
  655.     
  656.     3) If the tree subclass defines both a subTrees variable and key variable, the 
  657.     same restrictions apply as in (2) except that both sequenceable and non 
  658.     sequenceable collections are allowed. 
  659.     
  660.     4) We do not support tree subclasses defining a key variable without a subTrees 
  661.     variable. A key makes no sense in the absence of subTrees.
  662.     
  663.     5) Details of exactly which collection classes are legal in which circumstance 
  664.     may be obtained by browsing implementors of validateSubTreesClass:."
  665.  
  666.     self subclassResponsibility!
  667.  
  668. basicSuperTree
  669.     "Return the superTree if it is defined or nil otherwise."
  670.  
  671.     ^nil!
  672.  
  673. basicSuperTree: aTree
  674.     "If the receiver defines superTree, set it. Return the receiver."!
  675.  
  676. basicValue
  677.     "Return the value if it is defined or nil otherwise."
  678.  
  679.     ^nil!
  680.  
  681. basicValue: aValue
  682.     "If the receiver defines value, set it. Return the receiver."! !
  683.  
  684. !TreeLW methodsFor: 'private printing'!
  685.  
  686. branchMarker
  687.     "Return the character which marks a branch node when printed."
  688.  
  689.     ^self separator!
  690.  
  691. indentUnit
  692.     "Return a string to use for horizontally indenting tree nodes."
  693.  
  694.     ^ '. . .    '!
  695.  
  696. keyValueSeparator
  697.     "Return the separator to insert between the key and value, if any are defined, 
  698.     when printing the receiver."
  699.  
  700.     ^ ': '!
  701.  
  702. nodeName
  703.     "Return the default designation for a node when there is no suitable key or value 
  704.     to print."
  705.  
  706.     ^ 'node'!
  707.  
  708. nodePrintString
  709.     "Return a string representing a tree node. Subclasses not defining either a key or 
  710.     a value may want to redefine this."
  711.  
  712.     | stream |
  713.     stream := (String new: 32) writeStream.
  714.     (self definesKey and: [self key ~= self defaultKey])
  715.         ifTrue: [self key printSimplyOnLW: stream].
  716.     (self definesValue and: [self value ~= self defaultValue])
  717.         ifTrue: 
  718.             [stream isEmpty ifFalse: [self keyValueSeparator printSimplyOnLW: stream].
  719.             self value printSimplyOnLW: stream].
  720.     stream isEmpty ifTrue: [self nodeName printSimplyOnLW: stream].
  721.     self isBranch ifTrue: 
  722.         [| bm |
  723.         stream last ~= (bm := self branchMarker) ifTrue: [stream nextPut: bm]].
  724.     ^stream contents!
  725.  
  726. separator
  727.     "Return the filename separator character."
  728.  
  729.     ^Filename separator! !
  730.  
  731. !TreeLW methodsFor: 'private validating'!
  732.  
  733. validateKey: aKey 
  734.     "Raise an exception if aKey is invalid. This method is used by subclasses that 
  735.     store a key. A nil key would conflict with the <definesKey> method and would 
  736.     also conflict with clients that store subTrees in a Set. Sets cannot store nil."
  737.  
  738.     aKey isNil ifTrue: [self class badKeySignal raise]!
  739.  
  740. validateSubTrees: subTreesColl 
  741.     "Raise an exception if subTreesColl cannot be used for the subTrees. The 
  742.     method basicSubTrees: explains the argument."
  743.  
  744.     self validateSubTreesCollection: subTreesColl!
  745.  
  746. validateSubTreesClass: aClass 
  747.     "Raise an exception if aClass cannot be used for the subTrees collection of the 
  748.     receiver. This method is used by subclasses that store subTrees. 
  749.     
  750.     Another collection can be added to the list of legal collections below provided:
  751.     (1) its class understands <new>; (2) it can store trees; (3) it understands <addLW:>,
  752.     <removeLW:> and <remove:ifAbsentLW:>; (4) it understands <do:> and other
  753.     common enumeration messages; (5) it is sequenceable. Note that we have
  754.     enhanced Array with add/remove capability. Tree subclasses that support keyed
  755.     access relax condition (5) and support more collection classes. See implementors
  756.     of this method.
  757.     
  758.     Understanding <at:> and <at:put:> may be substituted for condition (3), but the 
  759.     resulting trees will not support the adding and removing protocols. 
  760.     
  761.     Performance note: this test is much faster than searching a collection of classes."
  762.  
  763.     (aClass == OrderedCollection or: [aClass == Array]) "some tree subclasses support more collection classes"
  764.         ifFalse: [self class badSubTreesSignal raise]!
  765.  
  766. validateSubTreesCollection: aCollection 
  767.     "Raise an exception if aCollection is an invalid collection type or stores invalid 
  768.     subtrees."
  769.  
  770.     self validateSubTreesClass: aCollection class.
  771.     aCollection do: [:tree | self validateTree: tree]!
  772.  
  773. validateTree: aTree 
  774.     "Raise an exception if aTree is not a tree or cannot be mixed with the receiver. It 
  775.     is illegal to mix trees defining superTree pointers with trees not defining them."
  776.  
  777.     aTree isTreeLW ifFalse: [self class notATreeSignal raise].
  778.     self definesSuperTree == aTree definesSuperTree ifFalse: [self class incompatibleTreeSignal raise]!
  779.  
  780. validateTreeClass: aClass 
  781.     "Raise an exception if an instance of aClass is not a tree."
  782.  
  783.     aClass basicNew isTreeLW ifFalse: [self class notATreeSignal raise]!
  784.  
  785. validateValue: aValue 
  786.     "Raise an exception if aValue is invalid. This method is used by subclasses that 
  787.     store a value. A nil value would conflict with the <definesValue> method."
  788.  
  789.     aValue isNil ifTrue: [self class badValueSignal raise]! !
  790.  
  791. !TreeLW methodsFor: 'private misc'!
  792.  
  793. attachTo: aTree 
  794.     "Set the superTree of the receiver, if it defines one, to aTree. Clients of this 
  795.     method are responsible for doing integrity checking."
  796.  
  797.     self basicSuperTree: aTree!
  798.  
  799. basicCopy: treeClass 
  800.     "Return a new instance of treeClass which shares the instance variables of the 
  801.     receiver. If it defines a superTree pointer, make it a root node. Clients are 
  802.     responsible for validating treeClass. This method is similar to shallowCopy. It
  803.     cannot use changeClassToThatOf: because the new class may contain fewer
  804.     instance variables.
  805.     
  806.     WARNING: subclasses may need to redefine this method if they add instance 
  807.     variables other than the ones assigned below.
  808.  
  809.     Comment: subclasses that need for some instance variables to be copied
  810.     when they build trees using this method may also redefine it."
  811.  
  812.     ^(treeClass basicNew)
  813.         basicKey: self basicKey;
  814.         basicValue: self basicValue;
  815.         basicSubTrees: self basicSubTrees;
  816.         makeRoot!
  817.  
  818. fastSubTrees: subTreesColl 
  819.     "Set the subTrees of the receiver to subTreesColl and answer the receiver. This 
  820.     method is optimized for speed by omitting some work done by the subTrees: 
  821.     method. It avoids validation and avoids converting the old subTrees into root 
  822.     nodes."
  823.  
  824.     self basicSubTrees: subTreesColl.
  825.     self definesSuperTree ifTrue: [self do: [:tree | tree attachTo: self]]!
  826.  
  827. makeRoot
  828.     "Make the receiver a root node and return it. Clients of this method are 
  829.     responsible for removing the receiver from its superTree if it has one."
  830.  
  831.     self basicSuperTree: self defaultSuperTree!
  832.  
  833. reOrderLW
  834.     "Restore the subTrees collection to its canonical ordering and return the 
  835.     receiver. Sets may need to be rehashed and SortedCollections may need to be 
  836.     resorted if their elements are modified. This is a noOp for subclasses not 
  837.     defining a subTrees variable because it is a noOp for the collections they 
  838.     synthesize. 
  839.     
  840.     This could have been called reOrder. We added the LW suffix to keep it 
  841.     analogous to <Collection reOrderLW>."
  842.  
  843.     self subTrees reOrderLW! !
  844. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  845.  
  846. TreeLW class
  847.     instanceVariableNames: ''!
  848.  
  849.  
  850. !TreeLW class methodsFor: 'class initialization'!
  851.  
  852. initialize
  853.     "TreeLW initialize"
  854.  
  855.     BadKeySignal := Object errorSignal newSignal nameClass: self message: #badKeySignal.
  856.     BadPathSignal := Object errorSignal newSignal nameClass: self message: #badPathSignal.
  857.     BadSubTreesSignal := Object errorSignal newSignal nameClass: self message: #badSubTreesSignal.
  858.     BadValueSignal := Object errorSignal newSignal nameClass: self message: #badValueSignal.
  859.     TreeNotFoundSignal := Object notFoundSignal newSignal nameClass: self message: #treeNotFoundSignal.
  860.     KeyNotFoundSignal := Object notFoundSignal newSignal nameClass: self message: #keyNotFoundSignal.
  861.     NotATreeSignal := Object errorSignal newSignal nameClass: self message: #notATreeSignal.
  862.     IncompatibleTreeSignal := Object errorSignal newSignal nameClass: self message: #incompatibleTreeSignal! !
  863.  
  864. !TreeLW class methodsFor: 'signal constants'!
  865.  
  866. badKeySignal
  867.     ^BadKeySignal notifierString:  'The key is illegal.'!
  868.  
  869. badPathSignal
  870.     ^BadPathSignal notifierString:  'Path is inaccessable.'!
  871.  
  872. badSubTreesSignal
  873.     ^BadSubTreesSignal notifierString:  'The subtrees specification is illegal.'!
  874.  
  875. badValueSignal
  876.     ^BadValueSignal notifierString:  'The value is illegal.'!
  877.  
  878. incompatibleTreeSignal
  879.     ^IncompatibleTreeSignal notifierString:  'Attempt to connect incompatible trees.'!
  880.  
  881. keyNotFoundSignal
  882.     ^KeyNotFoundSignal notifierString:  'Key not found.'!
  883.  
  884. notATreeSignal
  885.     ^NotATreeSignal notifierString:  'Expecting a tree.'!
  886.  
  887. treeNotFoundSignal
  888.     ^TreeNotFoundSignal notifierString: 'Tree not found.'! !
  889.  
  890. !TreeLW class methodsFor: 'instance creation'!
  891.  
  892. key: aKey 
  893.     "Create and return a new instance whose key, if defined by the receiver, is aKey. 
  894.     The argument may typically be any object except nil. The instance method 
  895.     validateKey: explains this."
  896.  
  897.     ^self new key: aKey!
  898.  
  899. key: aKey subTrees: subTreesColl
  900.     "Create and return a new instance whose key, if defined by the receiver, and 
  901.     whose subTrees are as specified."
  902.  
  903.     ^(self new) key: aKey; subTrees: subTreesColl!
  904.  
  905. key: aKey value: aValue 
  906.     "Create and return a new instance whose key and value, if defined by the receiver, 
  907.     are as specified."
  908.  
  909.     ^(self new) key: aKey; value: aValue!
  910.  
  911. key: aKey value: aValue subTrees: subTreesColl 
  912.     "Create and return a new instance whose key and value, if defined by the 
  913.     receiver, and whose subTrees are as specified."
  914.  
  915.     ^(self new) key: aKey; value: aValue; subTrees: subTreesColl!
  916.  
  917. new
  918.     "Return a new instance of the receiver with default values for its instance variables."
  919.  
  920.     ^super new initialize!
  921.  
  922. subTrees: subTreesColl 
  923.     "Create and return a new instance whose subTrees is subTreesColl. The instance 
  924.     methods basicSubTrees: and validateSubTrees: explain the argument."
  925.  
  926.     ^self new subTrees: subTreesColl!
  927.  
  928. value: aValue
  929.     "Create and return a new instance whose value, if defined by the receiver, is aValue.
  930.     The argument may typically be any object except nil. The instance method 
  931.     validateValue: explains this."
  932.  
  933.     ^self new value: aValue!
  934.  
  935. value: aValue subTrees: subTreesColl 
  936.     "Create and return a new instance whose value, if defined by the receiver, and 
  937.     whose subTrees are as specified."
  938.  
  939.     ^(self new) value: aValue; subTrees: subTreesColl! !
  940.  
  941. !TreeLW class methodsFor: 'examples'!
  942.  
  943. example0
  944.     "Many examples of how to use this class, and how to avoid misusing it, are in the 
  945.     test suites located in TesterTreeLW and its sister classes."!
  946.  
  947. example1
  948.     "Return a tree containing an organizational chart."
  949.  
  950.     "SKTreeLW example1"
  951.     "SVTreeLW example1"
  952.     "SKVTreeLW example1"
  953.  
  954.     | t1 t2 t3 t4 t5 |
  955.     t1 := self key: 'president' value: 'Bill'.
  956.     t2 := self key: 'secy of state' value: 'Warren'.
  957.     t3 := self key: 'secy of defense' value: 'Les'.
  958.     t4 := self key: 'under secy for Africa' value: 'Lino'.
  959.     t5 := self key: 'under secy for Latin America' value: 'Manuel'.
  960.     t1 add: t2; add: t3.
  961.     t2 add: t4; add: t5.
  962.     ^t1!
  963.  
  964. example2
  965.     "Return a tree containing a toy hierarchical database."
  966.  
  967.     "SKTreeLW example2"
  968.     "SVTreeLW example2"
  969.     "SKVTreeLW example2"
  970.  
  971.     | t1 t2 t3 t4 t5 t6 t7 t8 t9 |
  972.     t1 := self key: 'cultures'.
  973.     t2 := self key: 'Sudanese Arabic'.
  974.     t3 := self key: 'lexicon' value: #('ana: 1p s' 'shy: tea').
  975.     t4 := self key: 'grammar (hypothetical)' value: #('s = np vp' 'np = art n' 'vp = aux v' ).
  976.     t5 := self key: 'anthropology' value: 'Sudanese Arabs like their tea very sweet.'.
  977.     t6 := self key: 'Didinga'.
  978.     t7 := self key: 'lexicon' value: #('theythatch: termites' 'yani: that is (loan from Arabic)' ).
  979.     t8 := self key: 'grammar (hypothetical)' value: #('s = np vp' 'np = adj n' 'vp = mod v' ).
  980.     t9 := self key: 'anthropology' value: 'The Didinga people live in SE Sudan.'.
  981.     t1 add: t2; add: t6.
  982.     t2 add: t3; add: t4; add: t5.
  983.     t6 add: t7; add: t8; add: t9.
  984.     ^t1!
  985.  
  986. example3: aCollectionClass 
  987.     "Return a sample tree using aCollectionClass to store subtrees. This method
  988.     is used by some methods in the test suite. Do not change it, since the test
  989.     methods depend on the details of the tree it generates."
  990.  
  991.     "SKVTreeLW example3: OrderedCollection"
  992.     "SKVTreeLW example3: Array"
  993.     "SKVTreeLW example3: Set"
  994.     "SKVTreeLW example3: SortedCollection"
  995.  
  996.     | cl t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 |
  997.     cl := aCollectionClass.
  998.     t1 := self key: 1 value: $a subTrees: cl.
  999.     t2 := self key: 2 value: $b subTrees: cl.
  1000.     t3 := self key: 3 value: $c subTrees: cl.
  1001.     t4 := self key: 4 value: $d subTrees: cl.
  1002.     t5 := self key: 5 value: $e subTrees: cl.
  1003.     t6 := self key: 6 value: $f subTrees: cl.
  1004.     t7 := self key: 7 value: $g subTrees: cl new.    "An empty branch node."
  1005.     t8 := self key: 8 value: $h subTrees: cl.
  1006.     t9 := self key: 9 value: $i subTrees: cl.
  1007.     t10 := self key: 10 value: $j subTrees: cl.
  1008.     t11 := self key: 11 value: $k subTrees: cl.
  1009.     t12 := (self key: 12 value: $l subTrees: cl) makeBranch. "Another way of creating an empty branch node."
  1010.     t13 := self key: 13 value: $m subTrees: cl.
  1011.     t1 add: t2; add: t6; add: t7; add: t8.
  1012.     t2 add: t3; add: t4; add: t5.
  1013.     t8 add: t9; add: t10.
  1014.     t10 add: t11; add: t13.
  1015.     t11 add: t12.
  1016.     ^t1!
  1017.  
  1018. example4: aCollectionClass 
  1019.     "This is a pared down version of example3:. Do not change it.
  1020.     See example3: for comments."
  1021.  
  1022.     "SKVTreeLW example4: OrderedCollection"
  1023.     "SKVTreeLW example4: Array"
  1024.     "SKVTreeLW example4: Set"
  1025.     "SKVTreeLW example4: SortedCollection"
  1026.  
  1027.     | t1 t2 t3 t4 t5 t6 |
  1028.     t1 := self key: 1 value: $a subTrees: aCollectionClass.
  1029.     t2 := self key: 2 value: $b subTrees: aCollectionClass.
  1030.     t3 := self key: 3 value: $c subTrees: aCollectionClass.
  1031.     t4 := self key: 4 value: $d subTrees: aCollectionClass.
  1032.     t5 := self key: 5 value: $e subTrees: aCollectionClass.
  1033.     t6 := self key: 6 value: $f subTrees: aCollectionClass.
  1034.     t1 add: t2; add: t6.
  1035.     t2 add: t3; add: t4; add: t5.
  1036.     ^t1!
  1037.  
  1038. example5
  1039.     "Return a tree (sometimes called a trie) whose paths are the characters in 
  1040.     words. Data comes from an old Unix version of /usr/dict/words. Printing 
  1041.     protocol has not been designed to display this application optimally."
  1042.  
  1043.     "SKTreeLW example5"
  1044.     "SKVTreeLW example5"
  1045.  
  1046.     | t |
  1047.     t := self key: $* subTrees: OrderedCollection.
  1048.     #('a' 'aback' 'abacus' 'abalone' 'abandon' 'abase' 'abash' 'abate' 'abater' 'abbas' 'abbe' 'abbey' 'abbot' 'abbreviate' ) do: [:word | (t addPath: word) value value: $#].
  1049.     ^t!
  1050.  
  1051. example6
  1052.     "Return a tree illustrating how the nodes may be of various tree types and how 
  1053.     the subtrees collections may be of various collection types."
  1054.  
  1055.     "TreeLW example6"
  1056.  
  1057.     | t u v |
  1058.     t := STreeLW key: 1 subTrees: Array.
  1059.     u := SKTreeLW key: 2 subTrees: Set.
  1060.     v := SKVTreeLW key: 3 value: 33 subTrees: SortedCollection.
  1061.     t add: u; add: v.
  1062.     ^t!
  1063.  
  1064. example7
  1065.     "See also the example for BinaryTreeLW."
  1066.  
  1067.     "BinaryTreeLW example"! !
  1068.  
  1069. TreeLW subclass: #STreeLW
  1070.     instanceVariableNames: 'subTrees '
  1071.     classVariableNames: ''
  1072.     poolDictionaries: ''
  1073.     category: 'Public Domain-Trees'!
  1074. STreeLW comment:
  1075. 'This concrete class adds the ''subTrees'' variable to its superclass as explained in TreeLW. The ''S'' in the name comes from the ''s'' in subTrees. STreeLW adds support for
  1076.  
  1077.     indexed tree accessing (subTrees must be a sequenceable collection)
  1078.     adding and removing trees
  1079.     distinguishing between branches and leaves
  1080.     selecting trees
  1081.     converting between leaves and branches
  1082.     converting to a different collection class for holding subTrees.'!
  1083.  
  1084.  
  1085. !STreeLW methodsFor: 'accessing simple'!
  1086.  
  1087. subTrees
  1088.     "Return the subtrees, reporting an empty collection for a leaf node."
  1089.  
  1090.     ^self isLeaf
  1091.         ifTrue: [self basicSubTrees new]
  1092.         ifFalse: [self basicSubTrees]! !
  1093.  
  1094. !STreeLW methodsFor: 'accessing misc'!
  1095.  
  1096. atIndex: integer 
  1097.     "Return the subTree at the specified index. The subTrees collection must 
  1098.     understand at:. Raise an error exception if the index is invalid."
  1099.  
  1100.     ^self subTrees at: integer!
  1101.  
  1102. atIndex: integer put: aTree 
  1103.     "Put aTree at the specified index in the subTrees collection and answer aTree. 
  1104.     The collection must understand at: and at:put:. Raise an error exception if the 
  1105.     index is invalid. Although you can send add: to a leaf, you cannot send at:put:."
  1106.  
  1107.     self validateTree: aTree.
  1108.     (self atIndex: integer) makeRoot.
  1109.     aTree attachTo: self.
  1110.     ^self subTrees at: integer put: aTree! !
  1111.  
  1112. !STreeLW methodsFor: 'adding'!
  1113.  
  1114. add: aTree 
  1115.     "Add aTree to the subTrees collection and answer aTree. If the receiver is a leaf, 
  1116.     coerce it to a branch before adding to it."
  1117.  
  1118.     self validateTree: aTree.
  1119.     aTree attachTo: self makeBranch.
  1120.     ^self subTrees addLW: aTree!
  1121.  
  1122. addAll: collOfTrees 
  1123.     "Add collOfTrees to the receiver and answer collOfTrees. Applications working 
  1124.     with large sorted collections of keyed trees may want to optimize this method for 
  1125.     speed. See SortedCollection>>addAll:."
  1126.  
  1127.     collOfTrees do: [:tree | self add: tree].
  1128.     ^collOfTrees! !
  1129.  
  1130. !STreeLW methodsFor: 'removing'!
  1131.  
  1132. detach
  1133.     "Detach the receiver from its supertree, if it has one, and make it a root node.
  1134.     If it is already a root node, do nothing. Return the receiver."
  1135.  
  1136.     self isRoot ifFalse: [self superTree remove: self]!
  1137.  
  1138. prune
  1139.     "Prune unproductive branches, if any, from the receiver and return it. An 
  1140.     unproductive branch is one containing no leaves directly or recursively."
  1141.  
  1142.     self removeTreesSatisfying: [:tree | tree isProductive not]!
  1143.  
  1144. recursivePrune
  1145.     "Prune unproductive branches, if any, from the receiver and from its recursive 
  1146.     subtrees. Return the receiver. An unproductive branch is one containing no 
  1147.     leaves directly or recursively."
  1148.  
  1149.     self recursiveRemoveTreesSatisfying: [:tree | tree isProductive not]!
  1150.  
  1151. recursiveRemoveTreesSatisfying: aBlock 
  1152.     "Remove all direct and recursive subtrees from the receiver for which aBlock 
  1153.     evaluates to true and return the receiver. If a tree gets removed, all its 
  1154.     recursive subtrees do too, whether or not they evaluate to true."
  1155.  
  1156.     self removeTreesSatisfying: aBlock.
  1157.     self do: [:tree | tree recursiveRemoveTreesSatisfying: aBlock]!
  1158.  
  1159. remove: aTree 
  1160.     "Remove aTree from the subTrees collection and answer aTree. Raise an error 
  1161.     exception if absent."
  1162.  
  1163.     ^self remove: aTree ifAbsent: [self class treeNotFoundSignal raise]!
  1164.  
  1165. remove: aTree ifAbsent: aBlock 
  1166.     "Remove aTree from the subTrees collection. Answer aTree if it was present or 
  1167.     the result of evaluating aBlock if it was absent. Clients using this method must 
  1168.     be satisfied with the definition of the equality test (=)"
  1169.  
  1170.     ^self subTrees remove: aTree makeRoot ifAbsentLW: aBlock!
  1171.  
  1172. removeAll: collOfTrees 
  1173.     "Remove collOfTrees from the subTrees collection and answer collOfTrees. 
  1174.     Raise an error exception if any is absent. 
  1175.     
  1176.     Implementation note: we copy the collection before iterating over it just in case 
  1177.     the client happened to pass the subTrees collection itself."
  1178.  
  1179.     collOfTrees copy do: [:tree | self remove: tree].
  1180.     ^collOfTrees!
  1181.  
  1182. removeTreesSatisfying: aBlock 
  1183.     "Remove all direct subtrees from the receiver for which aBlock evaluates to true 
  1184.     and return the receiver."
  1185.  
  1186.     self subTrees copy do: [:tree | (aBlock value: tree)
  1187.             ifTrue: [self subTrees removeLW: tree makeRoot]]! !
  1188.  
  1189. !STreeLW methodsFor: 'testing misc'!
  1190.  
  1191. isLeaf
  1192.     "Return a boolean indicating whether the receiver is a leaf node."
  1193.  
  1194.     ^self basicSubTrees isBehavior! !
  1195.  
  1196. !STreeLW methodsFor: 'enumerating'!
  1197.  
  1198. recursiveSelect: aBlock inclusive: boolean 
  1199.     "Evaluate aBlock recursively (top down breadth first) on the receiver,
  1200.     forming new collections from the subtrees for which aBlock evaluates to
  1201.     true. Return the resulting tree or return nil. 
  1202.     
  1203.     If boolean is false, a copy of the receiver automatically becomes the root of 
  1204.     the resulting tree without being required to pass the test. If boolean is true, 
  1205.     the receiver is required to pass before its copy becomes the new root. If it 
  1206.     fails the test, nil is returned as the answer. 
  1207.  
  1208.     If any other tree fails the test, it and all its subtrees are excluded from the result.
  1209.  
  1210.     We do not define this for tree classes which lack a subTrees variable because
  1211.     they typically store a fixed number of subTrees."
  1212.  
  1213.     | newTree |
  1214.     boolean ifTrue: [(aBlock value: self) ifFalse: [^nil]].
  1215.     newTree := self basicCopy: self species.
  1216.     self isBranch
  1217.         ifTrue: 
  1218.             [| selectedTrees |
  1219.             selectedTrees := self subTrees select: aBlock.
  1220.             newTree fastSubTrees: (selectedTrees collectLW: [:subTree | subTree recursiveSelect: aBlock inclusive: false])].
  1221.     ^newTree!
  1222.  
  1223. select: aBlock 
  1224.     "Return a recursive copy of the receiver whose direct subtrees are those for 
  1225.     which aBlock evaluates to true. If the receiver is a leaf node, return a recursive 
  1226.     copy of it.
  1227.  
  1228.     We do not define this for tree classes which lack a subTrees variable because
  1229.     they typically store a fixed number of subTrees."
  1230.  
  1231.     | newTree |
  1232.     newTree := self recursiveCopy.
  1233.     self isBranch ifTrue: [newTree basicSubTrees: (newTree subTrees select: aBlock)].
  1234.     ^newTree! !
  1235.  
  1236. !STreeLW methodsFor: 'converting'!
  1237.  
  1238. clip
  1239.     "If the receiver is an empty branch, convert it to a leaf. Return the receiver.
  1240.  
  1241.     Implementation note: the test for isLeaf is not necessary but is included to
  1242.     boost performance for leaf nodes when this method called recursively."
  1243.  
  1244.     self isLeaf ifFalse: [self hasSubTrees ifFalse: [self makeLeaf]]!
  1245.  
  1246. makeBranch
  1247.     "Coerce the receiver to a branch node and return it."
  1248.  
  1249.     self isLeaf ifTrue: [self basicSubTrees: self basicSubTrees new]!
  1250.  
  1251. makeLeaf
  1252.     "Coerce the receiver to a leaf node and return it. Any subtrees it may have had 
  1253.     will be detached."
  1254.  
  1255.     self isBranch
  1256.         ifTrue: 
  1257.             [self definesSuperTree ifTrue: [self do: [:tree | tree makeRoot]].
  1258.             self basicSubTrees: self basicSubTrees class]!
  1259.  
  1260. recursiveClip
  1261.     "For the receiver and its immediate and recursive subtrees, convert empty 
  1262.     branches to leaves. Return the receiver. 
  1263.     
  1264.     Implementation note: we could have simply used recursiveDo:, but that defaults 
  1265.     to reOrder: true, which is not needed here. We prefer to optimize performance."
  1266.  
  1267.     self
  1268.         recursiveDo: [:tree | tree clip]
  1269.         inclusive: true
  1270.         topDown: true
  1271.         breadthFirst: true
  1272.         reOrder: false!
  1273.  
  1274. recursiveSubTreesAs: collectionClass 
  1275.     "Return a recursive copy of the receiver that uses collectionClass for storing 
  1276.     its direct and recursive subtrees. 
  1277.     
  1278.     Note that the as: message used here is sent to a collection, not to a tree."
  1279.  
  1280.     | newTree |
  1281.     self validateSubTreesClass: collectionClass.
  1282.     newTree := self basicCopy: self species.
  1283.     newTree fastSubTrees: (self isLeaf
  1284.             ifTrue: [collectionClass]
  1285.             ifFalse: [(self subTrees as: collectionClass)
  1286.                     collectLW: [:tree | tree recursiveSubTreesAs: collectionClass]]).
  1287.     ^newTree!
  1288.  
  1289. subTreesAs: collectionClass 
  1290.     "Return a recursive copy of the receiver that uses collectionClass for storing 
  1291.     its direct subtrees. 
  1292.     
  1293.     Note that the as: message used here is sent to a collection, not to a tree."
  1294.  
  1295.     | newTree |
  1296.     self validateSubTreesClass: collectionClass.
  1297.     newTree := self recursiveCopy.
  1298.     newTree basicSubTrees: (self isLeaf
  1299.             ifTrue: [collectionClass]
  1300.             ifFalse: [newTree subTrees as: collectionClass]).
  1301.     ^newTree! !
  1302.  
  1303. !STreeLW methodsFor: 'private initializing'!
  1304.  
  1305. defaultSubTrees
  1306.     "Return the default value for initializing the subTrees."
  1307.  
  1308.     ^OrderedCollection! !
  1309.  
  1310. !STreeLW methodsFor: 'private accessing'!
  1311.  
  1312. basicSubTrees
  1313.     "Return the contents of the subTrees variable. Do not redefine in subclasses."
  1314.  
  1315.     ^subTrees!
  1316.  
  1317. basicSubTrees: aCollectionOrClass 
  1318.     "Set the subTrees variable to aCollectionOrClass (e.g., Array new or Array) and 
  1319.     return the receiver. Do not redefine in subclasses. The basicSubTrees: method 
  1320.     in the superclass further explains the argument."
  1321.  
  1322.     subTrees := aCollectionOrClass! !
  1323.  
  1324. !STreeLW methodsFor: 'private validating'!
  1325.  
  1326. validateSubTrees: aCollectionOrClass 
  1327.     "Raise an exception if aCollectionOrClass cannot be used for the subTrees 
  1328.     collection of the receiver. A collection instance is used for branch nodes and
  1329.     a collection class for leaf nodes."
  1330.  
  1331.     aCollectionOrClass isBehavior
  1332.         ifTrue: [self validateSubTreesClass: aCollectionOrClass]
  1333.         ifFalse: [self validateSubTreesCollection: aCollectionOrClass]! !
  1334. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1335.  
  1336. STreeLW class
  1337.     instanceVariableNames: ''!
  1338.  
  1339.  
  1340. !STreeLW class methodsFor: 'examples'!
  1341.  
  1342. readMe
  1343.     "TreeLW contains examples for this class."! !
  1344.  
  1345. STreeLW subclass: #SKTreeLW
  1346.     instanceVariableNames: 'key '
  1347.     classVariableNames: ''
  1348.     poolDictionaries: ''
  1349.     category: 'Public Domain-Trees'!
  1350. SKTreeLW comment:
  1351. 'This concrete class adds the ''key'' variable to its superclass as explained in TreeLW.  The ''SK'' in the name comes from the ''s'' in subTrees and the ''k'' in key. SKTreeLW adds support for
  1352.  
  1353.     access to a subtree based on its key or path
  1354.     comparison of two trees based on their keys
  1355.     adding and removing a subtree based on its key or path
  1356.     tests based on the key or path
  1357.     printing operations based on the path
  1358.     other key and path based operations.
  1359.  
  1360. A path is a sequenceable collection of keys and is analogous to a directory path in a filesystem.
  1361.  
  1362. Adding a key variable also enables the use of sets and sorted collections for storing subTrees. The key is used to find a tree in a set and to compare two trees in a sorted collection. Methods in the comparing protocol must be based on the key alone.'!
  1363.  
  1364.  
  1365. !SKTreeLW methodsFor: 'accessing misc'!
  1366.  
  1367. atInclusivePath: aPath 
  1368.     "Same as atInclusive:ifAbsent:, but does default error handling."
  1369.  
  1370.     ^self atInclusivePath: aPath ifAbsent: [self class badPathSignal raise]!
  1371.  
  1372. atInclusivePath: aPath ifAbsent: aBlock 
  1373.     "Return the tree at aPath starting from the receiver. This path is a sequenceable 
  1374.     collection of keys inclusive of the receiver and inclusive of the last node. Return 
  1375.     the result of evaluating aBlock if not found."
  1376.  
  1377.     ^(aPath isEmpty or: [aPath first ~= self key])
  1378.         ifTrue: [aBlock value]
  1379.         ifFalse: [self atPath: (aPath copyFrom: 2 to: aPath size) ifAbsent: aBlock]!
  1380.  
  1381. atKey: aKey 
  1382.     "Return the subTree whose key equals aKey. Raise an error 
  1383.     exception if not found."
  1384.  
  1385.     ^self atKey: aKey ifAbsent: [self class keyNotFoundSignal raise]!
  1386.  
  1387. atKey: aKey ifAbsent: aBlock 
  1388.     "Return the subtree whose key equals aKey, or the result of evaluating 
  1389.     aBlock if not found. 
  1390.     
  1391.     In calling <elementMatching:ifAbsentLW:>, this method assumes that the
  1392.     equality test and hash function are based on the key alone. Subclasses
  1393.     should not relax this assumption. Each subtree must have a unique key. 
  1394.     
  1395.     A temporary tree is used as a probe to find the desired subtree."
  1396.  
  1397.     | aTree |
  1398.     aTree := self class basicNew basicKey: aKey.
  1399.     ^self subTrees elementMatching: aTree ifAbsentLW: aBlock!
  1400.  
  1401. atPath: aPath 
  1402.     "Same as atPath:ifAbsent:, but with default error handling."
  1403.  
  1404.     ^self atPath: aPath ifAbsent: [self class badPathSignal raise]!
  1405.  
  1406. atPath: aPath ifAbsent: aBlock 
  1407.     "Return the tree at aPath relative to the receiver. This path is a sequenceable 
  1408.     collection of keys exclusive of the receiver and inclusive of the last node. 
  1409.     Return the result of evaluating aBlock if not found."
  1410.  
  1411.     ^self
  1412.         atPath: aPath
  1413.         ifAbsentLeaf: aBlock
  1414.         ifAbsentBranch: aBlock!
  1415.  
  1416. atPath: aPath ifAbsentLeaf: block1 ifAbsentBranch: block2 
  1417.     "Return the tree at aPath relative to the receiver. This path is a sequenceable 
  1418.     collection of keys exclusive of the receiver and inclusive of the last node. If 
  1419.     there is no node at this path, and if the last node searched was a leaf/branch, 
  1420.     return the result of evaluating block1/ block2. If the receiver is a leaf node, 
  1421.     return the result of evaluating block1. This method enables more informative 
  1422.     error messages to be displayed than atPath:ifAbsent:."
  1423.  
  1424.     | node |
  1425.     self isLeaf ifTrue: [^block1 value].
  1426.     node := self.
  1427.     aPath do: [:aKey | node := node atKey: aKey ifAbsent: [^node isLeaf
  1428.                         ifTrue: [block1 value]
  1429.                         ifFalse: [block2 value]]].
  1430.     ^node!
  1431.  
  1432. fullPathKeys
  1433.     "Return an array containing keys of nodes from the root to the receiver, inclusive 
  1434.     of both. If the receiver is a root node, the array will contain the key of the 
  1435.     receiver as its single element."
  1436.  
  1437.     ^self fullPathNodes collectLW: [:aNode | aNode key]!
  1438.  
  1439. keys
  1440.     "Return the keys of the subtrees."
  1441.  
  1442.     ^self subTrees collectLW: [:tree | tree key]!
  1443.  
  1444. rootlessPathKeys
  1445.     "Return an array containing keys of nodes from the root to the receiver, 
  1446.     excluding the root and including the receiver. If the receiver is a root node, the 
  1447.     array will be empty."
  1448.  
  1449.     ^self rootlessPathNodes collectLW: [:aNode | aNode key]! !
  1450.  
  1451. !SKTreeLW methodsFor: 'comparing'!
  1452.  
  1453. < aTree 
  1454.     "Answer whether the receiver is less than aTree. By defining this selector and <=, 
  1455.     we make it possible to use a sorted collection for the subtrees. The other 
  1456.     traditional comparison operators are not needed for sorting but could be defined. 
  1457.     We could get most of them for free by making TreeLW a subclass of 
  1458.     Magnitude, but this would be artificial, since it would only be usable by keyed 
  1459.     trees."
  1460.  
  1461.     ^self key < aTree key!
  1462.  
  1463. <= aTree 
  1464.     "Answer whether the receiver is less than or equal to aTree. The motivation for 
  1465.     defining this is explained in the < method."
  1466.  
  1467.     ^(aTree key < self key) not!
  1468.  
  1469. = aTree 
  1470.     "Answer whether the receiver is equal to aTree. Equality testing must
  1471.     be based on the key alone. Subclasses should not change this. See
  1472.     TreeLW>>atKey:ifAbsent for an explanation."
  1473.  
  1474.     ^aTree isTreeLW and: [self key = aTree key]!
  1475.  
  1476. hash
  1477.     "Answer a SmallInteger derived from to the receiver. Hashing must be based on 
  1478.     the key alone. Subclasses should not change this. See TreeLW>>atKey:ifAbsent
  1479.     for an explanation."
  1480.  
  1481.     ^self key hash! !
  1482.  
  1483. !SKTreeLW methodsFor: 'adding'!
  1484.  
  1485. addKey: aKey 
  1486.     "Add a tree with the specified key to the subTrees collection and answer aKey. If 
  1487.     the receiver is a leaf, coerce it to a branch before adding to it."
  1488.  
  1489.     self add: ((self class key: aKey) basicSubTrees: self subTrees class).
  1490.     ^aKey!
  1491.  
  1492. addKeys: collOfKeys 
  1493.     "Add collOfKeys to the receiver and answer collOfKeys. See addAll: for 
  1494.     optimization comment."
  1495.  
  1496.     collOfKeys do: [:aKey | self addKey: aKey].
  1497.     ^collOfKeys!
  1498.  
  1499. addPath: aPath 
  1500.     "Add trees along aPath to the receiver and return (count -> last tree in path).
  1501.     In more detail: 
  1502.     
  1503.     Starting from the receiver, traverse its nodes along aPath. The path is a 
  1504.     sequenceable collection of keys exclusive of the receiver. The receiver 
  1505.     may already contain the entire path. If not, extend the receiver with the new 
  1506.     nodes.
  1507.     
  1508.     Return an association whose key is the number of nodes added to the 
  1509.     receiver (possibly zero) and whose value is the last node in the path. If the 
  1510.     path is empty, return (0 -> receiver).
  1511.  
  1512.     Note that in contrast to the other add methods, this protects against creating
  1513.     duplicate keys within each subtrees collection."
  1514.  
  1515.     | aTree n |
  1516.     n := 0.
  1517.     aTree := self.
  1518.     aPath do: [:aKey | aTree := aTree atKey: aKey
  1519.                     ifAbsent: 
  1520.                         [n := n + 1.
  1521.                         aTree add: ((self class key: aKey) basicSubTrees: self subTrees class)]].
  1522.     ^n -> aTree! !
  1523.  
  1524. !SKTreeLW methodsFor: 'removing'!
  1525.  
  1526. removeKey: aKey 
  1527.     "Remove a tree with the specified key from the subTrees collection and answer 
  1528.     aKey. Raise an error exception if absent."
  1529.  
  1530.     ^self removeKey: aKey ifAbsent: [self class keyNotFoundSignal raise]!
  1531.  
  1532. removeKey: aKey ifAbsent: aBlock 
  1533.     "Remove a tree with the specified key from the subTrees collection. Answer aKey 
  1534.     if it was present or the result of evaluating aBlock if it was absent."
  1535.  
  1536.     | tree |
  1537.     tree := self atKey: aKey ifAbsent: [^aBlock value].
  1538.     self subTrees removeLW: tree makeRoot.
  1539.     ^aKey!
  1540.  
  1541. removeKeys: collOfKeys 
  1542.     "Remove trees keyed by collOfKeys from the subTrees collection and answer 
  1543.     collOfKeys. Raise an error exception if any is absent."
  1544.  
  1545.     collOfKeys do: [:aKey | self removeKey: aKey].
  1546.     ^collOfKeys!
  1547.  
  1548. removePath: aPath 
  1549.     "Remove the tree stored at aPath. Return aPath if present or the result of 
  1550.     raising an error exception if absent. The path is a non empty sequenceable 
  1551.     collection of keys exclusive of the receiver."
  1552.  
  1553.     ^self removePath: aPath ifAbsent: [self class badPathSignal raise]!
  1554.  
  1555. removePath: aPath ifAbsent: aBlock 
  1556.     "Remove the tree stored at aPath. Return aPath if present or the result of 
  1557.     evaluating aBlock if absent. The path is a non empty sequenceable collection of 
  1558.     keys exclusive of the receiver."
  1559.  
  1560.     | size |
  1561.     (size := aPath size) > 0
  1562.         ifTrue: 
  1563.             [| tree |
  1564.             tree := self atPath: (aPath copyFrom: 1 to: size - 1) ifAbsent: [^aBlock value].
  1565.             tree removeKey: aPath last ifAbsent: [^aBlock value].
  1566.             ^aPath]
  1567.         ifFalse: [^aBlock value]! !
  1568.  
  1569. !SKTreeLW methodsFor: 'testing misc'!
  1570.  
  1571. hasSamePathAs: aTree 
  1572.     "Return whether the receiver has the same path from its root as aTree. If the 
  1573.     receiver does not define a superTree, it is its own root node. A simpler 
  1574.     implementation would be ^self fullPathNodes = aTree fullPathNodes. But that
  1575.     would be slower, especially when the answer is false."
  1576.  
  1577.     ^self key = aTree key and: [self isRoot
  1578.             ifTrue: [aTree isRoot]
  1579.             ifFalse: [aTree isRoot not and: [self superTree hasSamePathAs: aTree superTree]]]!
  1580.  
  1581. includesInclusivePath: aPath 
  1582.     "Answer whether the receiver includes trees along aPath, which is a 
  1583.     sequenceable collection of keys inclusive of the receiver."
  1584.  
  1585.     ^(self atInclusivePath: aPath ifAbsent: [nil]) notNil!
  1586.  
  1587. includesKey: aKey 
  1588.     "Return a boolean indicating whether aKey belongs to a direct subtree of the 
  1589.     receiver."
  1590.  
  1591.     ^self includes: (self class basicNew basicKey: aKey)!
  1592.  
  1593. includesPath: aPath 
  1594.     "Answer whether the receiver includes trees along aPath, which is a 
  1595.     sequenceable collection of keys exclusive of the receiver."
  1596.  
  1597.     ^(self atPath: aPath ifAbsent: [nil]) notNil! !
  1598.  
  1599. !SKTreeLW methodsFor: 'printing misc'!
  1600.  
  1601. fullPathString
  1602.     "Return a string describing the path from the root to the receiver, inclusive of 
  1603.     both. If the receiver is a root node, the string will represent the key of the 
  1604.     receiver only."
  1605.  
  1606.     ^self stringFromPathKeys: self fullPathKeys!
  1607.  
  1608. immediatePathString
  1609.     "Return a string representing the immediate path from the super tree to the 
  1610.     receiver, inclusive of both. If the receiver is a root node, the string will represent 
  1611.     the key of the receiver only."
  1612.  
  1613.     ^self stringFromPathNodes: (self isRoot
  1614.             ifTrue: [Array with: self]
  1615.             ifFalse: [Array with: self superTree with: self])!
  1616.  
  1617. rootlessPathString
  1618.     "Return a string describing the path from the root to the receiver, excluding the 
  1619.     root and including the receiver. If the receiver is a root node, return an empty 
  1620.     string."
  1621.  
  1622.     ^self stringFromPathKeys: self rootlessPathKeys!
  1623.  
  1624. stringFromPathKeys: aPath 
  1625.     "Return a string describing aPath, which is a sequenceable collection of 
  1626.     keys. Contrary to stringFromPathNodes:, a final separator is not appended."
  1627.  
  1628.     ^self stringFromPathKeys: aPath separator: self separator!
  1629.  
  1630. stringFromPathKeys: aPath separator: separatorChar 
  1631.     "Return a string describing aPath, which is a sequenceable collection of 
  1632.     keys, using separatorChar as the separator. Contrary to 
  1633.     stringFromPathNodes:, a final separator is not appended."
  1634.  
  1635.     | stream |
  1636.     stream := (String new: 64) writeStream.
  1637.     aPath
  1638.         do: 
  1639.             [:aKey | 
  1640.             stream nextPutAll: (aKey simplePrintStringLW copyWithout: separatorChar).
  1641.             stream nextPut: separatorChar].
  1642.     stream size > 1 ifTrue: [stream skip: -1].
  1643.     ^stream contents!
  1644.  
  1645. stringFromPathNodes: aPath
  1646.     "Return a string describing aPath, which is a sequenceable collection of
  1647.     nodes. If the last node is a branch, the last character will be a separator."
  1648.  
  1649.     | stream separator |
  1650.     stream := (String new: 64) writeStream.
  1651.     separator := self separator.
  1652.     aPath
  1653.         do: 
  1654.             [:node | 
  1655.             stream nextPutAll: (node key simplePrintStringLW copyWithout: separator).
  1656.             node isBranch ifTrue: [stream nextPut: separator]].
  1657.     ^stream contents! !
  1658.  
  1659. !SKTreeLW methodsFor: 'private accessing'!
  1660.  
  1661. basicKey
  1662.     "Return the contents of the key variable. Do not redefine in subclasses."
  1663.  
  1664.     ^key!
  1665.  
  1666. basicKey: aKey 
  1667.     "Set the key variable to anObject and return the receiver. Do not redefine in 
  1668.     subclasses."
  1669.  
  1670.     key := aKey! !
  1671.  
  1672. !SKTreeLW methodsFor: 'private validating'!
  1673.  
  1674. validateSubTreesClass: aClass 
  1675.     "Same as superclass but less restrictive. Defining a <key> instance variable 
  1676.     enables us to add Set and SortedCollection to the list of supported collections."
  1677.  
  1678.     (aClass == OrderedCollection or: [aClass == Array or: [aClass == Set or: [aClass == SortedCollection]]])
  1679.         ifFalse: [self class badSubTreesSignal raise]! !
  1680. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1681.  
  1682. SKTreeLW class
  1683.     instanceVariableNames: ''!
  1684.  
  1685.  
  1686. !SKTreeLW class methodsFor: 'instance creation'!
  1687.  
  1688. leafFromPath: aPath 
  1689.     "Same as rootFromPath: except that the last node on the path is returned."
  1690.  
  1691.     | root |
  1692.     root := self key: aPath first.
  1693.     ^(root addPath: (aPath copyFrom: 2 to: aPath size)) value!
  1694.  
  1695. rootFromPath: aPath 
  1696.     "Create and return a new instance containing nodes along aPath. The path is a 
  1697.     non empty sequenceable collection of keys starting from the new root node. 
  1698.     Return the resulting root node."
  1699.  
  1700.     | root |
  1701.     root := self key: aPath first.
  1702.     root addPath: (aPath copyFrom: 2 to: aPath size).
  1703.     ^root! !
  1704.  
  1705. !SKTreeLW class methodsFor: 'examples'!
  1706.  
  1707. readMe
  1708.     "TreeLW contains examples for this class."! !
  1709.  
  1710. SKTreeLW subclass: #SKPTreeLW
  1711.     instanceVariableNames: 'superTree '
  1712.     classVariableNames: ''
  1713.     poolDictionaries: ''
  1714.     category: 'Public Domain-Trees'!
  1715. SKPTreeLW comment:
  1716. 'This concrete class adds the ''superTree'' variable to its superclass as explained in TreeLW. The ''SKP'' in the name comes from the ''s'' in subTrees, the ''k'' in key and the ''p'' in superTree.'!
  1717.  
  1718.  
  1719. !SKPTreeLW methodsFor: 'private accessing'!
  1720.  
  1721. basicSuperTree
  1722.     "Return the contents of the superTree variable. Do not redefine in subclasses."
  1723.  
  1724.     ^superTree!
  1725.  
  1726. basicSuperTree: aTree 
  1727.     "Set the superTree variable to aTree and return the receiver. If the argument is a 
  1728.     tree, it becomes the superTree of the receiver. If the argument is something 
  1729.     else (except nil, which is not allowed), the receiver becomes a root node. Do not 
  1730.     redefine in subclasses."
  1731.  
  1732.     superTree := aTree! !
  1733. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1734.  
  1735. SKPTreeLW class
  1736.     instanceVariableNames: ''!
  1737.  
  1738.  
  1739. !SKPTreeLW class methodsFor: 'examples'!
  1740.  
  1741. readMe
  1742.     "TreeLW contains examples for this class."! !
  1743.  
  1744. SKPTreeLW subclass: #SKPVTreeLW
  1745.     instanceVariableNames: 'value '
  1746.     classVariableNames: ''
  1747.     poolDictionaries: ''
  1748.     category: 'Public Domain-Trees'!
  1749. SKPVTreeLW comment:
  1750. 'This concrete class adds the ''value'' variable to its superclass as explained in TreeLW. The ''SKPV'' in the name comes from the ''s'' in subTrees, the ''k'' in key, the ''p'' in superTree and the ''v'' in value.'!
  1751.  
  1752.  
  1753. !SKPVTreeLW methodsFor: 'private accessing'!
  1754.  
  1755. basicValue
  1756.     "Return the contents of the value variable. Do not redefine in subclasses."
  1757.  
  1758.     ^value!
  1759.  
  1760. basicValue: anObject 
  1761.     "Set the value variable to anObject and return the receiver. Do not redefine in 
  1762.     subclasses."
  1763.  
  1764.     value := anObject! !
  1765. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1766.  
  1767. SKPVTreeLW class
  1768.     instanceVariableNames: ''!
  1769.  
  1770.  
  1771. !SKPVTreeLW class methodsFor: 'examples'!
  1772.  
  1773. readMe
  1774.     "TreeLW contains examples for this class."! !
  1775.  
  1776. SKTreeLW subclass: #SKVTreeLW
  1777.     instanceVariableNames: 'value '
  1778.     classVariableNames: ''
  1779.     poolDictionaries: ''
  1780.     category: 'Public Domain-Trees'!
  1781. SKVTreeLW comment:
  1782. 'This concrete class adds the ''value'' variable to its superclass as explained in TreeLW. The ''SKV'' in the name comes from the ''s'' in subTrees, the ''k'' in key and the ''v'' in value.'!
  1783.  
  1784.  
  1785. !SKVTreeLW methodsFor: 'private accessing'!
  1786.  
  1787. basicValue
  1788.     "Return the contents of the value variable. Do not redefine in subclasses."
  1789.  
  1790.     ^value!
  1791.  
  1792. basicValue: anObject 
  1793.     "Set the value variable to anObject and return the receiver. Do not redefine in 
  1794.     subclasses."
  1795.  
  1796.     value := anObject! !
  1797. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1798.  
  1799. SKVTreeLW class
  1800.     instanceVariableNames: ''!
  1801.  
  1802.  
  1803. !SKVTreeLW class methodsFor: 'examples'!
  1804.  
  1805. readMe
  1806.     "TreeLW contains examples for this class."! !
  1807.  
  1808. STreeLW subclass: #SPTreeLW
  1809.     instanceVariableNames: 'superTree '
  1810.     classVariableNames: ''
  1811.     poolDictionaries: ''
  1812.     category: 'Public Domain-Trees'!
  1813. SPTreeLW comment:
  1814. 'This concrete class adds the ''superTree'' variable to its superclass as explained in TreeLW. The ''SP'' in the name comes from the ''s'' in subTrees and the ''p'' in superTree.'!
  1815.  
  1816.  
  1817. !SPTreeLW methodsFor: 'private accessing'!
  1818.  
  1819. basicSuperTree
  1820.     "Return the contents of the superTree variable. Do not redefine in subclasses."
  1821.  
  1822.     ^superTree!
  1823.  
  1824. basicSuperTree: aTree 
  1825.     "Set the superTree variable to aTree and return the receiver. If the argument is a 
  1826.     tree, it becomes the superTree of the receiver. If the argument is something 
  1827.     else (except nil, which is not allowed), the receiver becomes a root node. Do not 
  1828.     redefine in subclasses."
  1829.  
  1830.     superTree := aTree! !
  1831. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1832.  
  1833. SPTreeLW class
  1834.     instanceVariableNames: ''!
  1835.  
  1836.  
  1837. !SPTreeLW class methodsFor: 'examples'!
  1838.  
  1839. readMe
  1840.     "TreeLW contains examples for this class."! !
  1841.  
  1842. SPTreeLW subclass: #SPVTreeLW
  1843.     instanceVariableNames: 'value '
  1844.     classVariableNames: ''
  1845.     poolDictionaries: ''
  1846.     category: 'Public Domain-Trees'!
  1847. SPVTreeLW comment:
  1848. 'This concrete class adds the ''value'' variable to its superclass as explained in TreeLW. The ''SPV'' in the name comes from the ''s'' in subTrees, the ''p'' in superTree and the ''v'' in value.'!
  1849.  
  1850.  
  1851. !SPVTreeLW methodsFor: 'private accessing'!
  1852.  
  1853. basicValue
  1854.     "Return the contents of the value variable. Do not redefine in subclasses."
  1855.  
  1856.     ^value!
  1857.  
  1858. basicValue: anObject 
  1859.     "Set the value variable to anObject and return the receiver. Do not redefine in 
  1860.     subclasses."
  1861.  
  1862.     value := anObject! !
  1863. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1864.  
  1865. SPVTreeLW class
  1866.     instanceVariableNames: ''!
  1867.  
  1868.  
  1869. !SPVTreeLW class methodsFor: 'examples'!
  1870.  
  1871. readMe
  1872.     "TreeLW contains examples for this class."! !
  1873.  
  1874. STreeLW subclass: #SVTreeLW
  1875.     instanceVariableNames: 'value '
  1876.     classVariableNames: ''
  1877.     poolDictionaries: ''
  1878.     category: 'Public Domain-Trees'!
  1879. SVTreeLW comment:
  1880. 'This concrete class adds the ''value'' variable to its superclass as explained in TreeLW. The ''SV'' in the name comes from the ''s'' in subTrees and the ''v'' in value.'!
  1881.  
  1882.  
  1883. !SVTreeLW methodsFor: 'private accessing'!
  1884.  
  1885. basicValue
  1886.     "Return the contents of the value variable. Do not redefine in subclasses."
  1887.  
  1888.     ^value!
  1889.  
  1890. basicValue: anObject 
  1891.     "Set the value variable to anObject and return the receiver. Do not redefine in 
  1892.     subclasses."
  1893.  
  1894.     value := anObject! !
  1895. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1896.  
  1897. SVTreeLW class
  1898.     instanceVariableNames: ''!
  1899.  
  1900.  
  1901. !SVTreeLW class methodsFor: 'examples'!
  1902.  
  1903. readMe
  1904.     "TreeLW contains examples for this class."! !
  1905.  
  1906. TreeLW subclass: #PTreeLW
  1907.     instanceVariableNames: 'superTree '
  1908.     classVariableNames: ''
  1909.     poolDictionaries: ''
  1910.     category: 'Public Domain-Trees'!
  1911. PTreeLW comment:
  1912. 'This abstract class adds the ''superTree'' variable to its superclass as explained in TreeLW. The ''P'' in the name comes from the ''p'' in superTree.'!
  1913.  
  1914.  
  1915. !PTreeLW methodsFor: 'private accessing'!
  1916.  
  1917. basicSuperTree
  1918.     "Return the contents of the superTree variable. Do not redefine in subclasses."
  1919.  
  1920.     ^superTree!
  1921.  
  1922. basicSuperTree: aTree 
  1923.     "Set the superTree variable to aTree and return the receiver. If the argument is a 
  1924.     tree, it becomes the superTree of the receiver. If the argument is something 
  1925.     else (except nil, which is not allowed), the receiver becomes a root node. Do not 
  1926.     redefine in subclasses."
  1927.  
  1928.     superTree := aTree! !
  1929. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1930.  
  1931. PTreeLW class
  1932.     instanceVariableNames: ''!
  1933.  
  1934.  
  1935. !PTreeLW class methodsFor: 'examples'!
  1936.  
  1937. readMe
  1938.     "TreeLW contains examples for this class."! !
  1939.  
  1940. PTreeLW subclass: #PVTreeLW
  1941.     instanceVariableNames: 'value '
  1942.     classVariableNames: ''
  1943.     poolDictionaries: ''
  1944.     category: 'Public Domain-Trees'!
  1945. PVTreeLW comment:
  1946. 'This abstract class adds the ''value'' variable to its superclass as explained in TreeLW. The ''PV'' in the name comes from the ''p'' in superTree and the ''v'' in value.'!
  1947.  
  1948.  
  1949. !PVTreeLW methodsFor: 'private accessing'!
  1950.  
  1951. basicValue
  1952.     "Return the contents of the value variable. Do not redefine in subclasses."
  1953.  
  1954.     ^value!
  1955.  
  1956. basicValue: anObject 
  1957.     "Set the value variable to anObject and return the receiver. Do not redefine in 
  1958.     subclasses."
  1959.  
  1960.     value := anObject! !
  1961. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1962.  
  1963. PVTreeLW class
  1964.     instanceVariableNames: ''!
  1965.  
  1966.  
  1967. !PVTreeLW class methodsFor: 'examples'!
  1968.  
  1969. readMe
  1970.     "TreeLW contains examples for this class."! !
  1971.  
  1972. TreeLW subclass: #VTreeLW
  1973.     instanceVariableNames: 'value '
  1974.     classVariableNames: ''
  1975.     poolDictionaries: ''
  1976.     category: 'Public Domain-Trees'!
  1977. VTreeLW comment:
  1978. 'This abstract class adds the ''value'' variable to its superclass as explained in TreeLW. The ''V'' in the name comes from the ''v'' in value.'!
  1979.  
  1980.  
  1981. !VTreeLW methodsFor: 'private accessing'!
  1982.  
  1983. basicValue
  1984.     "Return the contents of the value variable. Do not redefine in subclasses."
  1985.  
  1986.     ^value!
  1987.  
  1988. basicValue: anObject 
  1989.     "Set the value variable to anObject and return the receiver. Do not redefine in 
  1990.     subclasses."
  1991.  
  1992.     value := anObject! !
  1993. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1994.  
  1995. VTreeLW class
  1996.     instanceVariableNames: ''!
  1997.  
  1998.  
  1999. !VTreeLW class methodsFor: 'examples'!
  2000.  
  2001. readMe
  2002.     "TreeLW contains examples for this class."! !
  2003.  
  2004. VTreeLW subclass: #BinaryTreeLW
  2005.     instanceVariableNames: 'left right '
  2006.     classVariableNames: ''
  2007.     poolDictionaries: ''
  2008.     category: 'Public Domain-Trees'!
  2009. BinaryTreeLW comment:
  2010. 'A BinaryTreeLW is a concrete class defined for pedagogic purposes as a tree whose branch nodes have two subtrees and whose leaf nodes have none. It provides an example of how to define a TreeLW subclass that lacks a subTrees variable.
  2011.  
  2012. Another implementation technique would be to define a new collection class that holds the two nodes. However, that would take 20 bytes more per node for ST80 4.1 than the technique used here.
  2013.  
  2014. If one wished to use less memory than the current technique, one could define separate classes for branches and leaves. Leaves would not have ''left'' or ''right'' instance variables. However, that would make it harder to design subclasses of binary trees.
  2015.  
  2016. BinaryTreeLW is a subclass of VTreeLW. If one wanted to define a binary tree that maintained a superTree pointer, it would be a subclass of PVTreeLW. The superclass would maintain the pointer automatically and no extra code would be required in BinaryTreeLW. See the left:right: method for further comments.
  2017.  
  2018. A BTree or BalancedTree could be defined in a manner similar to BinaryTreeLW.
  2019.  
  2020. Instance Variables
  2021.  
  2022. (value)            <Object (not nil)>    (Inherited): The object stored at a node.
  2023. left                <TreeLW | nil>        The left subtree for a branch node; nil for a leaf node.
  2024. right            <TreeLW | nil>        The right subtree for a branch node; nil for a leaf node.'!
  2025.  
  2026.  
  2027. !BinaryTreeLW methodsFor: 'accessing simple'!
  2028.  
  2029. left
  2030.     "Return the left node if the receiver is a branch or nil if it is a leaf."
  2031.  
  2032.     ^left!
  2033.  
  2034. left: tree1 right: tree2 
  2035.     "Set the two nodes and return the receiver. To make the receiver a leaf node, 
  2036.     use subTrees: Array new. 
  2037.     
  2038.     Implementation note: this is based on the subTrees: method to take advantage 
  2039.     of that method's argument validation. If BinaryTreeLW had been defined as a 
  2040.     subclass of PVTreeLW, using subTrees: would also take advantage of its 
  2041.     automatic management of the superTree pointer."
  2042.  
  2043.     self subTrees: (Array with: tree1 with: tree2)!
  2044.  
  2045. right
  2046.     "Return the right node if the receiver is a branch or nil if it is a leaf."
  2047.  
  2048.     ^right! !
  2049.  
  2050. !BinaryTreeLW methodsFor: 'testing misc'!
  2051.  
  2052. isLeaf
  2053.     "Return a boolean indicating whether the receiver is a leaf node. 
  2054.     
  2055.     Implementation note: we do not need to test the right node because either both 
  2056.     are trees or both are nil."
  2057.  
  2058.     ^self left isNil! !
  2059.  
  2060. !BinaryTreeLW methodsFor: 'private initializing'!
  2061.  
  2062. defaultSubTrees
  2063.     "Return the default value for initializing the subTrees."
  2064.  
  2065.     ^Array new! !
  2066.  
  2067. !BinaryTreeLW methodsFor: 'private accessing'!
  2068.  
  2069. basicSubTrees
  2070.     "Return an array containing the subtrees."
  2071.  
  2072.     ^self isLeaf
  2073.         ifTrue: [Array new]
  2074.         ifFalse: [Array with: self left with: self right]!
  2075.  
  2076. basicSubTrees: seqColl 
  2077.     "Set the left and right nodes from seqColl, assuming it is a sequenceable 
  2078.     collection of zero or two trees. Return the receiver."
  2079.  
  2080.     seqColl isEmpty
  2081.         ifTrue: 
  2082.             [left := nil.
  2083.             right := nil]
  2084.         ifFalse: 
  2085.             [left := seqColl at: 1.
  2086.             right := seqColl at: 2]! !
  2087.  
  2088. !BinaryTreeLW methodsFor: 'private validating'!
  2089.  
  2090. validateSubTreesCollection: aCollection 
  2091.     "Raise an exception if aCollection is invalid. It must be empty or contain exactly 
  2092.     two compatible trees."
  2093.  
  2094.     | size |
  2095.     super validateSubTreesCollection: aCollection.
  2096.     ((size := aCollection size) = 0 or: [size = 2])
  2097.         ifFalse: [self class badSubTreesSignal raise]! !
  2098. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2099.  
  2100. BinaryTreeLW class
  2101.     instanceVariableNames: ''!
  2102.  
  2103.  
  2104. !BinaryTreeLW class methodsFor: 'instance creation'!
  2105.  
  2106. left: tree1 right: tree2 
  2107.     "Create and return a new instance with the specified subtrees. A leaf node is 
  2108.     created with BinaryTreeLW new."
  2109.  
  2110.     ^self new left: tree1 right: tree2! !
  2111.  
  2112. !BinaryTreeLW class methodsFor: 'examples'!
  2113.  
  2114. example
  2115.     "Return a sample tree with five nodes."
  2116.  
  2117.     "self example"
  2118.  
  2119.     | t1 t2 t3 t4 t5 |
  2120.     t1 := self value: 1.
  2121.     t2 := self value: 2.
  2122.     t3 := self value: 3.
  2123.     t4 := self value: 4.
  2124.     t5 := self value: 5.
  2125.     t1 left: t2 right: t5.
  2126.     t2 left: t3 right: t4.
  2127.     ^t1! !
  2128. TreeLW initialize!
  2129.  
  2130. Object subclass: #TesterLW
  2131.     instanceVariableNames: ''
  2132.     classVariableNames: 'DataBlockCount ErrorBlockCount '
  2133.     poolDictionaries: ''
  2134.     category: 'Public Domain-Testing-Public Access'!
  2135. TesterLW comment:
  2136. '(1) PUBLIC DOMAIN FILEIN COMMENTS (same as TreeLW)
  2137.  
  2138. (2) NORMAL CLASS COMMENTS
  2139.  
  2140. Class TesterLW is used to verify the correctness of the class and instance methods in another class. It is designed for testing back end calculation and storage classes such as numbers and collections, but is less suitable for testing user interface classes. An example will serve to explain its usage.
  2141.  
  2142. Suppose you want to verify the class TreeLW. TreeLW''s test suite will be called TesterTreeLW and will be a subclass of TesterLW. The methods in the test suite will have the same names as the methods in TreeLW. Each test method will have block(s) of code designed by the programmer to exercise the corresponding method in TreeLW. TesterLW evaluates the blocks and compares the results with expected results. The test for this method passes if all compare and fails otherwise.
  2143.  
  2144. Normally you will want to test a method''s response both to error conditions and to normal conditions. If you fill a block with code designed to raise an exception, TesterLW will confirm that the expected error actually occurred. If you fill a block with code designed to generate data, TesterLW will confirm that the correct data got generated. In the two respective cases, a string representing the error or a string representing the data is compared with an expected string.
  2145.  
  2146. Now let''s go through the steps for setting up and running a test suite for TreeLW and its subclasses.
  2147.  
  2148. (1) Define TesterForTreesLW along with the leaf nodes in the class hierarchy shown below. In other applications the class analogous to TesterForTreesLW may not be necessary. See its class comment for why it is needed here.
  2149.  
  2150.     TesterLW ()
  2151.         TesterForTreesLW ()
  2152.             TesterBinaryTreeLW ()
  2153.             TesterPTreeLW ()
  2154.             TesterPVTreeLW ()
  2155.             TesterSKPTreeLW ()
  2156.             TesterSKPVTreeLW ()
  2157.             TesterSKTTreeLW ()
  2158.             TesterSKVTTreeLW ()
  2159.             TesterSPTTreeLW ()
  2160.             TesterSPVTreeLW ()
  2161.             TesterSTreeLW ()
  2162.             TesterSVTreeLW ()
  2163.             TesterTreeLW ()
  2164.             TesterVTreeLW ()
  2165.  
  2166. (2) Create method stubs for these classes by evaluating
  2167.  
  2168.     | classes |
  2169.     classes := #(BinaryTreeLW PTreeLW PVTreeLW SKPTreeLW SKPVTreeLW SKTreeLW SKVTreeLW SPTreeLW SPVTreeLW STreeLW SVTreeLW TreeLW VTreeLW)
  2170.     collect: [:sym | Smalltalk at: sym].
  2171.     classes do: [:class | TesterLW new createStubsFor: class].
  2172.  
  2173. The list of classes could be replaced by <TreeLW withAllSubclasses> if you don''t have any application specific subclasses of TreeLW which you wish to exclude from the tests.
  2174.  
  2175. (3) Edit the stubs to fill them with test code. This is where the bulk of the work lies. Use the TesterTreeLW methods as examples.
  2176.  
  2177. (4) There will probably remain some stubs you didn''t edit because there was nothing interesting to test. Remove them by evaluating
  2178.  
  2179.     | classes |
  2180.     classes := #(BinaryTreeLW PTreeLW PVTreeLW SKPTreeLW SKPVTreeLW SKTreeLW SKVTreeLW SPTreeLW SPVTreeLW STreeLW SVTreeLW TreeLW VTreeLW)
  2181.     collect: [:sym | Smalltalk at: sym].
  2182.     classes do: [:class | TesterLW new removeStubsFor: class].
  2183.  
  2184. The list of classes could be replaced by <TreeLW withAllSubclasses> if you don''t have any application specific subclasses of TreeLW which you wish to exclude from the tests.
  2185.  
  2186. (5) Run the tests by evaluating the code below and viewing the results in the System Transcript.
  2187.  
  2188.     TesterForTreesLW new runAllSubclasses.
  2189.  
  2190. Because the methods in a test suite use the same names as the methods they''re verifying, they can be cross referenced by the system browser using ''implementors'' as well as ''senders''. A programmer learning a new class can search its test suite for examples of idiomatic usage. An individual test can be run by highlighting and evaluating its code to observe the performance of the method it is verifying.
  2191.  
  2192. Shortcomings of this technique: (1) We are assuming the test results can be characterized by a string. This is too simplistic for some situations. In particular, the technique is not suited for testing methods implementing user interface logic or methods that interact heavily with some other subsystem. (2) The strings will be very dependent on error messages and on printing protocols. The test methods will require updating whenever an error message or print format is changed. (3) We generate testing stubs for those methods directly defined by a class, but not for those inherited by a class. A programmer wishing to test inherited methods will have to write the test method from scratch.
  2193.  
  2194. The following cannot be instance variables because they must be accessable from class methods.
  2195.  
  2196. Class Variables
  2197.  
  2198. ErrorBlockCount    <Integer>    Number of blocks of error raising code executed during a test run.
  2199. DataBlockCount    <Integer>    Number of blocks of data generating code executed during a test run.
  2200. '!
  2201.  
  2202.  
  2203. !TesterLW methodsFor: 'public'!
  2204.  
  2205. createStubsFor: testeeClass 
  2206.     "Create class and instance method stubs for testing testeeClass. Preserve 
  2207.     intact any test methods that already exist. Also add a class comment if one 
  2208.     does not exist."
  2209.  
  2210.     "TesterLW new createStubsFor: TreeLW"
  2211.  
  2212.     | testerClass |
  2213.     (testerClass := self testerClassFor: testeeClass interactive: true) notNil
  2214.         ifTrue: 
  2215.             [self addMethodsFrom: testeeClass class to: testerClass class.
  2216.             self addMethodsFrom: testeeClass to: testerClass.
  2217.             testerClass comment isEmpty ifTrue: [testerClass comment: self commentTemplate , testeeClass name , '.']]!
  2218.  
  2219. removeStubsFor: testeeClass 
  2220.     "Remove class and instance method stubs from the test suite for testeeClass. 
  2221.     Only remove those methods with stub code but not those with actual test code. 
  2222.     Also remove protocols that no longer contain methods."
  2223.  
  2224.     "TesterLW new removeStubsFor: TreeLW"
  2225.  
  2226.     | testerClass |
  2227.     (testerClass := self testerClassFor: testeeClass interactive: true) notNil ifTrue:
  2228.         [self removeStubMethodsFrom: testerClass class.
  2229.         self removeStubMethodsFrom: testerClass]!
  2230.  
  2231. run: testerClass 
  2232.     "Run the test suite for testerClass, reporting the results to the System 
  2233.     Transcript. Paint some colors in windows to provide amusement."
  2234.  
  2235.     "TesterLW new run: TesterTreeLW; cleanUp"
  2236.  
  2237.     (testerClass isBehavior and: [testerClass inheritsFrom: TesterLW])
  2238.         ifFalse: [^self explainError: (self testerClassErrorMessage: testerClass printString) interactive: false].
  2239.     Cursor square
  2240.         showWhile: 
  2241.             [| cursors color nPasses nFails np nf nd ne |
  2242.             cursors := (Array
  2243.                         with: Cursor origin
  2244.                         with: Cursor bottomLeft
  2245.                         with: Cursor corner
  2246.                         with: Cursor topRight) readStream.
  2247.             color := Random new.
  2248.             self paint: color.
  2249.             nPasses := nFails := ErrorBlockCount := DataBlockCount := 0.
  2250.             (Array with: testerClass class with: testerClass)
  2251.                 do: [:cl | cl selectors asSortedCollection
  2252.                         do: 
  2253.                             [:sel | 
  2254.                             cursors atEnd ifTrue: [cursors reset].
  2255.                             cursors next
  2256.                                 showWhile: 
  2257.                                     [Object errorSignal
  2258.                                         handle: 
  2259.                                             [:ex | 
  2260.                                             self explainError: 'Fail ' , cl name , '>>' , sel , '... ' , ex errorString interactive: false.
  2261.                                             nFails := nFails + 1]
  2262.                                         do: 
  2263.                                             [cl basicNew perform: sel withArguments: (Array new: sel numArgs).
  2264.                                             nPasses := nPasses + 1].
  2265.                                     self
  2266.                                         paint: color
  2267.                                         for: testerClass
  2268.                                         n: nPasses + nFails]]].
  2269.             (Delay forMilliseconds: 300) wait.
  2270.             self paint: color.
  2271.             np := nPasses printString prependWith: $0 maxLW: 3.
  2272.             nf := nFails printString prependWith: $0 maxLW: 3.
  2273.             nd := DataBlockCount printString prependWith: $0 maxLW: 3.
  2274.             ne := ErrorBlockCount printString prependWith: $0 maxLW: 3.
  2275.             Transcript cr; show: np , '/' , nf , ' methods passed/failed; ' , nd , '/' , ne , ' data/error blocks evaluated for ' , testerClass name , '.'.
  2276.             (Delay forMilliseconds: 300) wait]!
  2277.  
  2278. runAll: collOfTesterClasses 
  2279.     "Run the test suites for collOfTesterClasses, reporting the results to the 
  2280.     System Transcript."
  2281.  
  2282.     collOfTesterClasses do: [:testerClass | self run: testerClass].
  2283.     self cleanUp!
  2284.  
  2285. runAllSubclasses
  2286.     "Run the test suites for all subclasses of the receiver (a tester class), reporting 
  2287.     the results to the System Transcript."
  2288.  
  2289.     "TesterForTreesLW new runAllSubclasses"
  2290.  
  2291.     self runAllSubclassesOf: self class!
  2292.  
  2293. runAllSubclassesOf: testerClass 
  2294.     "Run the test suites for all subclasses of testerClass, reporting the results to the 
  2295.     System Transcript."
  2296.  
  2297.     "TesterLW new runAllSubclassesOf: TesterForTreesLW"
  2298.  
  2299.     self runAll: (testerClass allSubclasses asSortedCollection: [:cl1 :cl2 | cl1 name <= cl2 name])!
  2300.  
  2301. test: testeeClass 
  2302.     "Run the test suite for testeeClass, reporting the results to the System 
  2303.     Transcript. Paint some colors in windows to provide amusement."
  2304.  
  2305.     "TesterLW new test: TreeLW; cleanUp"
  2306.  
  2307.     | testerClass |
  2308.     (testerClass := self testerClassFor: testeeClass interactive: false) notNil ifTrue: [self run: testerClass]!
  2309.  
  2310. testAll: collOfTesteeClasses 
  2311.     "Run the test suites for collOfTesteeClasses, reporting the results to the 
  2312.     System Transcript."
  2313.  
  2314.     collOfTesteeClasses do: [:testeeClass | self test: testeeClass].
  2315.     self cleanUp!
  2316.  
  2317. testWithAllSubclassesOf: testeeClass 
  2318.     "Run the test suites for testeeClass and all its subclasses, reporting the results 
  2319.     to the System Transcript."
  2320.  
  2321.     "TesterLW new testWithAllSubclassesOf: TreeLW"
  2322.  
  2323.     self testAll: (testeeClass withAllSubclasses asSortedCollection: [:cl1 :cl2 | cl1 name <= cl2 name])! !
  2324.  
  2325. !TesterLW methodsFor: 'private'!
  2326.  
  2327. addMethodsFrom: testeeClass to: testerClass 
  2328.     "Add method stubs to testerClass corresponding to the methods in testeeClass, 
  2329.     preserving the order of the protocols in which they are organized in testeeClass.
  2330.     Do not overwrite methods already present in testerClass."
  2331.  
  2332.     | org1 protocols1 selectors2 |
  2333.     org1 := testeeClass organization.
  2334.     protocols1 := org1 categories.
  2335.     selectors2 := testerClass selectors.
  2336.     protocols1
  2337.         do: 
  2338.             [:prot | 
  2339.             | selectors1 |
  2340.             selectors1 := org1 listAtCategoryNamed: prot.
  2341.             selectors1 do: [:sel | (selectors2 includes: sel)
  2342.                     ifFalse: [self
  2343.                             addStubFor: sel
  2344.                             in: prot
  2345.                             from: testeeClass
  2346.                             to: testerClass]]]!
  2347.  
  2348. addStubFor: aSelector in: aProtocol from: testeeClass to: testerClass 
  2349.     "Add a stub method corresponding to aSelector in aProtocol in testeeClass to 
  2350.     testerClass. 
  2351.     
  2352.     Implementation note: We need to copy the first line from the original source 
  2353.     code to the new source code. This line will be terminated by cr (Mac) or lf (Unix) 
  2354.     or crlf (DOS) depending on which platform was used to write it. If you write some 
  2355.     source code on one platform and later move your image to another platform, 
  2356.     Smalltalk will not translate the line end conventions of the old source code to 
  2357.     match the new platform."
  2358.  
  2359.     | originalSource firstLine newSource |
  2360.     originalSource := testeeClass sourceCodeAt: aSelector.
  2361.     firstLine := originalSource readStream upToAfterAnyInLW: (Array with: Character cr with: Character lf).
  2362.     newSource := firstLine  , self methodTemplate.
  2363.     testerClass compile: newSource classified: aProtocol!
  2364.  
  2365. cleanUp
  2366.     "Flush the System Transcript and clean up the colors that got painted in windows.
  2367.     Call this after running a test suite."
  2368.  
  2369.     Transcript flush.
  2370.     ScheduledControllers restore!
  2371.  
  2372. comment: ignore test: aBlock expectError: aString 
  2373.     "Evaluate aBlock and raise an exception if the resulting normalized error string 
  2374.     does not equal aString normalized."
  2375.  
  2376.     self class
  2377.         comment: ignore
  2378.         test: aBlock
  2379.         expectError: aString!
  2380.  
  2381. comment: ignore test: aBlock expectResult: aString 
  2382.     "Evaluate aBlock and raise an exception if the resulting normalized print string 
  2383.     does not equal aString normalized."
  2384.  
  2385.     self class
  2386.         comment: ignore
  2387.         test: aBlock
  2388.         expectResult: aString!
  2389.  
  2390. commentTemplate
  2391.     "Return a string containing a template for the class comment."
  2392.  
  2393.     ^'Test suite for '!
  2394.  
  2395. explainError: errorMssg interactive: boolean 
  2396.     "Present errorMssg to the user, either in a dialog box if boolean is true or in the 
  2397.     System Transcript if it is false. Defer displaying message in the transcript until 
  2398.     it is flushed. Return nil."
  2399.  
  2400.     | fullMssg |
  2401.     fullMssg := '***** ' , errorMssg.
  2402.     boolean
  2403.         ifTrue: [DialogView warn: fullMssg]
  2404.         ifFalse: [Transcript cr; nextPutAll: fullMssg].
  2405.     ^nil!
  2406.  
  2407. methodTemplate
  2408.     "Return a string to use as the method source code template. This template is 
  2409.     designed to cooperate with the Smalltalk code formatter, at least for 
  2410.     ObjectWorks 4.1 and VisualWorks 1.0. Watch out for the difference between its 
  2411.     use of double quote (comment delimiter) and its use of doubled single quote 
  2412.     (literal single quote inside a string)."
  2413.  
  2414.     ^'
  2415.     "general comments"
  2416.  
  2417.     self
  2418.         comment: ["comment"]
  2419.         test: [self error: ''error message'']
  2420.         expectError: ''error message''.
  2421.     self
  2422.         comment: ["comment"]
  2423.         test: [''test data'']
  2424.         expectResult: ''test data'''!
  2425.  
  2426. paint: color 
  2427.     "Paint a random color in each window of the current project using color to 
  2428.     generate the colors. This is to amuse the programmer during long test runs."
  2429.  
  2430.     | controllers |
  2431.     (controllers := ScheduledControllers scheduledControllers) notNil ifTrue: [controllers
  2432.             do: 
  2433.                 [:controller | 
  2434.                 | gc |
  2435.                 gc := controller view graphicsContext.
  2436.                 gc paint: (ColorValue
  2437.                         red: color next
  2438.                         green: color next
  2439.                         blue: color next).
  2440.                 gc displayRectangle: gc clippingBounds]]!
  2441.  
  2442. paint: color for: testerClass n: nRect 
  2443.     "Paint a random color in a sub rectangle of the view of the currently active 
  2444.     controller using color to generate the colors. The last two arguments determine 
  2445.     the size and position of the rectangle in a way that provides feedback on how 
  2446.     many test methods have been run. This is to amuse the programmer during 
  2447.     long test runs."
  2448.  
  2449.     | ctl gc rect nRects height top |
  2450.     (ctl := ScheduledControllers activeController) notNil
  2451.         ifTrue: 
  2452.             [gc := ctl view graphicsContext.
  2453.             rect := gc clippingBounds.
  2454.             nRects := testerClass selectors size + testerClass class selectors size max: 1.
  2455.             height := rect height / nRects.
  2456.             gc paint: (ColorValue
  2457.                     red: color next
  2458.                     green: color next
  2459.                     blue: color next).
  2460.             gc displayRectangle: (Rectangle
  2461.                     left: rect left
  2462.                     right: rect right
  2463.                     top: (top := nRect - 1 * height + rect top)
  2464.                     bottom: top + height + 1)]!
  2465.  
  2466. removeStubMethodsFrom: testerClass 
  2467.     "Remove method stubs from testerClass. Do not remove methods with actual 
  2468.     test code. Remove protocols which no longer contain methods.
  2469.     
  2470.     Implementation note: the stub could have been created on (Mac Unix DOS) 
  2471.     with (cr lf crlf) as line end convention. If it was created on a different platform 
  2472.     from the current one, the old line end convention will still be there in the source 
  2473.     code. The situation is similar for addStubFor:in:from:to:."
  2474.  
  2475.     testerClass selectors
  2476.         do: 
  2477.             [:sel | 
  2478.             | source strippedSource strippedTemplate |
  2479.             source := (testerClass sourceCodeAt: sel) readStream.
  2480.             source upToAfterAnyInLW: (Array with: Character cr with: Character lf).    "skip over first line of source"
  2481.             strippedSource := (source upToEnd copyWithout: Character cr) copyWithout: Character lf.
  2482.             strippedTemplate := (self methodTemplate copyWithout: Character cr) copyWithout: Character lf.
  2483.             strippedSource = strippedTemplate ifTrue: [testerClass removeSelector: sel]].
  2484.     testerClass organization removeEmptyCategories!
  2485.  
  2486. testerClassErrorMessage: name 
  2487.     "Return the error message to use when passed a bad tester class designated by 
  2488.     name."
  2489.  
  2490.     ^'Expecting ' , name , ' to be a subclass of TesterLW.'!
  2491.  
  2492. testerClassFor: testeeClass interactive: boolean 
  2493.     "Return the tester class for testeeClass or nil if there was an error.
  2494.     If boolean is true, warn the user interactively of problems. If it is false,
  2495.     log problems to the System Transcript."
  2496.  
  2497.     "do this and see the error message"        "TesterLW new testerClassFor: #Object interactive: true"
  2498.     "do this and see the error message"        "TesterLW new testerClassFor: Object interactive: true"
  2499.     "print this and see the resulting class"    "TesterLW new testerClassFor: TreeLW interactive: true"
  2500.  
  2501.     | testerName testerClass |
  2502.     testeeClass isBehavior ifFalse: [^self explainError: 'Expecting ' , testeeClass printString , ' to be a class.' interactive: boolean].
  2503.     testerName := ('Tester' , testeeClass name) asSymbol.
  2504.     ^((Smalltalk includesKey: testerName)
  2505.         and: [(testerClass := Smalltalk at: testerName) isBehavior and: [testerClass inheritsFrom: TesterLW]])
  2506.         ifTrue: [testerClass]
  2507.         ifFalse: [self explainError: (self testerClassErrorMessage: testerName) interactive: boolean]! !
  2508. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2509.  
  2510. TesterLW class
  2511.     instanceVariableNames: ''!
  2512.  
  2513.  
  2514. !TesterLW class methodsFor: 'private'!
  2515.  
  2516. comment: ignore test: aBlock expectError: aString 
  2517.     "Evaluate aBlock and raise an exception if the resulting normalized error string 
  2518.     does not equal aString normalized or if an error is not detected. This method is 
  2519.     used when testing code that is expected to generate an error."
  2520.  
  2521.     | normalizedError normalizedString |
  2522.     ErrorBlockCount := ErrorBlockCount + 1.
  2523.     Object errorSignal
  2524.         handle: 
  2525.             [:ex |
  2526.             normalizedError := self normalizeError: ex errorString copy.
  2527.             normalizedString := self normalizeError: aString copy.
  2528.             normalizedError = normalizedString
  2529.                 ifTrue: [^nil "test succeeded"]
  2530.                 ifFalse: [^self error: 'Detected wrong error.']]
  2531.         do: aBlock.
  2532.     self error: 'Failed to detect an error.'!
  2533.  
  2534. comment: ignore test: aBlock expectResult: aString 
  2535.     "Evaluate aBlock and raise an exception if the resulting normalized print string 
  2536.     does not equal aString normalized. This method is used when testing code 
  2537.     that is not expected to generate an error."
  2538.  
  2539.     | normalizedResult normalizedString |
  2540.     DataBlockCount := DataBlockCount + 1.
  2541.     normalizedResult := self normalizeResult: aBlock value simplePrintStringLW.
  2542.     normalizedString := self normalizeResult: aString copy.
  2543.     normalizedResult = normalizedString
  2544.         ifTrue: ["test succeeded"]
  2545.         ifFalse: [self error: 'Generated incorrect data.']!
  2546.  
  2547. normalize: aString 
  2548.     "Return a normalized version of aString. This is a hook for subclasses that need 
  2549.     to normalize strings before comparing them. For example, test methods may 
  2550.     produce strings containing file separator characters such as /:\ for Unix, Mac, 
  2551.     and DOS. If these strings were compared to a fixed string, the test would work 
  2552.     on the original platform on which it was prepared but would fail on other 
  2553.     platforms."
  2554.  
  2555.     ^aString!
  2556.  
  2557. normalizeError: aString 
  2558.     "Return a normalized version of aString arising from testing code that should
  2559.     generate an error. Subclasses may define different normalizations for error 
  2560.     generating code and non error generating code."
  2561.  
  2562.     ^self normalize: aString!
  2563.  
  2564. normalizeResult: aString 
  2565.     "Return a normalized version of aString arising from testing code that should not 
  2566.     generate an error. Subclasses may define different normalizations for error 
  2567.     generating code and non error generating code."
  2568.  
  2569.     ^self normalize: aString! !
  2570.  
  2571. TesterLW subclass: #TesterForTreesLW
  2572.     instanceVariableNames: ''
  2573.     classVariableNames: ''
  2574.     poolDictionaries: ''
  2575.     category: 'Public Domain-Testing-Subclasses'!
  2576. TesterForTreesLW comment:
  2577. 'This class defines string normalization for use with trees. See its sole method for details.'!
  2578.  
  2579. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2580.  
  2581. TesterForTreesLW class
  2582.     instanceVariableNames: ''!
  2583.  
  2584.  
  2585. !TesterForTreesLW class methodsFor: 'private'!
  2586.  
  2587. normalizeResult: aString 
  2588.     "Return a normalized version of aString. The normalization we perform is to 
  2589.     convert filename separator characters to an arbitrary canonical character. We 
  2590.     need to do this because tree paths and tree print strings contain these 
  2591.     separators, and they are platform specific. Unix, Mac, DOS respectively use \:/. 
  2592.     If we did not normalize, tests prepared on one platform would fail on another 
  2593.     platform."
  2594.  
  2595.     ^aString replaceAnyIn: '\:/' withLW: $\! !
  2596.  
  2597. TesterForTreesLW subclass: #TesterBinaryTreeLW
  2598.     instanceVariableNames: ''
  2599.     classVariableNames: ''
  2600.     poolDictionaries: ''
  2601.     category: 'Public Domain-Testing-Trees'!
  2602. TesterBinaryTreeLW comment:
  2603. 'Test suite for BinaryTreeLW.'!
  2604.  
  2605.  
  2606. !TesterBinaryTreeLW methodsFor: 'accessing simple'!
  2607.  
  2608. left
  2609.     self
  2610.         comment: ["Left tree of a leaf node."]
  2611.         test: [BinaryTreeLW new left]
  2612.         expectResult: 'nil'.
  2613.     self
  2614.         comment: ["Left tree of a branch node."]
  2615.         test: 
  2616.             [| t |
  2617.             t := BinaryTreeLW
  2618.                         left: (BinaryTreeLW value: 1)
  2619.                         right: (BinaryTreeLW value: 2).
  2620.             t left]
  2621.         expectResult: '
  2622. 1'!
  2623.  
  2624. left: tree1 right: tree2 
  2625.     "Already tested by the class instance creation method."!
  2626.  
  2627. right
  2628.     self
  2629.         comment: ["Right tree of a leaf node."]
  2630.         test: [BinaryTreeLW new right]
  2631.         expectResult: 'nil'.
  2632.     self
  2633.         comment: ["Right tree of a branch node."]
  2634.         test: 
  2635.             [| t |
  2636.             t := BinaryTreeLW
  2637.                         left: (BinaryTreeLW value: 1)
  2638.                         right: (BinaryTreeLW value: 2).
  2639.             t right]
  2640.         expectResult: '
  2641. 2'! !
  2642.  
  2643. !TesterBinaryTreeLW methodsFor: 'testing misc'!
  2644.  
  2645. isLeaf
  2646.     self
  2647.         comment: ["Leaf node is created with <new>."]
  2648.         test: [BinaryTreeLW new isLeaf]
  2649.         expectResult: 'true'.
  2650.     self
  2651.         comment: ["Branch node is created with <left:right:>."]
  2652.         test: 
  2653.             [| t |
  2654.             t := BinaryTreeLW left: BinaryTreeLW new right: BinaryTreeLW new.
  2655.             t isLeaf]
  2656.         expectResult: 'false'! !
  2657.  
  2658. !TesterBinaryTreeLW methodsFor: 'private initializing'!
  2659.  
  2660. defaultSubTrees
  2661.     "This gets tested implicitly whenever a tree is created in the test suite. Writing 
  2662.     an explicit tests would not be interesting."! !
  2663.  
  2664. !TesterBinaryTreeLW methodsFor: 'private accessing'!
  2665.  
  2666. basicSubTrees
  2667.     self
  2668.         comment: ["We call <subTrees>, the public interface, which ends up calling 
  2669.             <basicSubTrees>. This is for a branch node."]
  2670.         test: 
  2671.             [| t1 t2 t3 |
  2672.             t1 := BinaryTreeLW value: 1.
  2673.             t2 := BinaryTreeLW value: 2.
  2674.             t3 := BinaryTreeLW value: 3.
  2675.             t1 left: t2 right: t3.
  2676.             t1 subTrees]
  2677.         expectResult: '#(
  2678. 3 )'.
  2679.     self
  2680.         comment: ["This is for a leaf node."]
  2681.         test: [BinaryTreeLW new subTrees]
  2682.         expectResult: '#()'!
  2683.  
  2684. basicSubTrees: seqColl 
  2685.     self
  2686.         comment: ["TesterTreeLW class>>subTrees: tested all error conditions except 
  2687.             the one tested here, which is a seqColl with the wrong number of trees."]
  2688.         test: [BinaryTreeLW new subTrees: BinaryTreeLW new]
  2689.         expectError: 'The subtrees specification is illegal.'.
  2690.     self
  2691.         comment: ["We call <subTrees:>, the public interface, which ends up calling 
  2692.             <basicSubTrees:>. t1 is a branch node. t4 is a leaf node."]
  2693.         test: 
  2694.             [| t1 t2 t3 t4 |
  2695.             t1 := BinaryTreeLW value: 1.
  2696.             t2 := BinaryTreeLW value: 2.
  2697.             t3 := BinaryTreeLW value: 3.
  2698.             t1 subTrees: (Array with: t2 with: t3).
  2699.             t4 := t1 copy.
  2700.             t4 subTrees: Array new.
  2701.             Array with: t1 with: t4]
  2702.         expectResult: '#(
  2703. 1\
  2704. . . .    2
  2705. . . .    3 
  2706. 1 )'! !
  2707.  
  2708. !TesterBinaryTreeLW methodsFor: 'private validating'!
  2709.  
  2710. validateSubTreesCollection: aCollection 
  2711.     "This is implicitly tested by the <basicSubTrees:> method. See its comment."! !
  2712. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2713.  
  2714. TesterBinaryTreeLW class
  2715.     instanceVariableNames: ''!
  2716.  
  2717.  
  2718. !TesterBinaryTreeLW class methodsFor: 'instance creation'!
  2719.  
  2720. left: tree1 right: tree2 
  2721.     self
  2722.         comment: ["Both arguments must be trees."]
  2723.         test: [BinaryTreeLW left: nil right: nil]
  2724.         expectError: 'Expecting a tree.'.
  2725.     self
  2726.         comment: ["A trivial binary tree."]
  2727.         test: 
  2728.             [| t1 t2 t3 |
  2729.             t2 := BinaryTreeLW value: 2.
  2730.             t3 := BinaryTreeLW value: 3.
  2731.             t1 := BinaryTreeLW left: t2 right: t3.
  2732.             t1 value: 1]
  2733.         expectResult: '
  2734. 1\
  2735. . . .    2
  2736. . . .    3'! !
  2737.  
  2738. TesterForTreesLW subclass: #TesterPTreeLW
  2739.     instanceVariableNames: ''
  2740.     classVariableNames: ''
  2741.     poolDictionaries: ''
  2742.     category: 'Public Domain-Testing-Trees'!
  2743. TesterPTreeLW comment:
  2744. 'Test suite for PTreeLW.'!
  2745.  
  2746.  
  2747. !TesterPTreeLW methodsFor: 'private accessing'!
  2748.  
  2749. basicSuperTree
  2750.     self
  2751.         comment: ["Look at a root node and a non root node. We use SPVTreeLW
  2752.             to be able to print values and because PTreeLW and PVTreeLW are 
  2753.             abstract classes. Printing the resulting supertrees implicitly tests the
  2754.             <basicSuperTree> method."]
  2755.         test: 
  2756.             [| t1 t2 |
  2757.             t1 := SPVTreeLW value: 1.
  2758.             t2 := SPVTreeLW value: 2.
  2759.             t1 add: t2.
  2760.             Array with: t1 superTree with: t2 superTree]
  2761.         expectResult: '#(#none 
  2762. 1\
  2763. . . .    2 )'!
  2764.  
  2765. basicSuperTree: aTree 
  2766.     "The <basicSuperTree:> method is implicitly tested by <basicSuperTree>."! !
  2767.  
  2768. TesterForTreesLW subclass: #TesterPVTreeLW
  2769.     instanceVariableNames: ''
  2770.     classVariableNames: ''
  2771.     poolDictionaries: ''
  2772.     category: 'Public Domain-Testing-Trees'!
  2773. TesterPVTreeLW comment:
  2774. 'Test suite for PVTreeLW.'!
  2775.  
  2776.  
  2777. !TesterPVTreeLW methodsFor: 'private accessing'!
  2778.  
  2779. privateAccessing
  2780.     "See the tests in VTreeLW. There is nothing new to add here."! !
  2781.  
  2782. TesterForTreesLW subclass: #TesterSKPTreeLW
  2783.     instanceVariableNames: ''
  2784.     classVariableNames: ''
  2785.     poolDictionaries: ''
  2786.     category: 'Public Domain-Testing-Trees'!
  2787. TesterSKPTreeLW comment:
  2788. 'Test suite for SKPTreeLW.'!
  2789.  
  2790.  
  2791. !TesterSKPTreeLW methodsFor: 'private accessing'!
  2792.  
  2793. privateAccessing
  2794.     "See the tests in PTreeLW. There is nothing new to add here."! !
  2795.  
  2796. TesterForTreesLW subclass: #TesterSKPVTreeLW
  2797.     instanceVariableNames: ''
  2798.     classVariableNames: ''
  2799.     poolDictionaries: ''
  2800.     category: 'Public Domain-Testing-Trees'!
  2801. TesterSKPVTreeLW comment:
  2802. 'Test suite for SKPVTreeLW.'!
  2803.  
  2804.  
  2805. !TesterSKPVTreeLW methodsFor: 'private accessing'!
  2806.  
  2807. privateAccessing
  2808.     "See the tests in VTreeLW. There is nothing new to add here."! !
  2809.  
  2810. TesterForTreesLW subclass: #TesterSKTreeLW
  2811.     instanceVariableNames: ''
  2812.     classVariableNames: ''
  2813.     poolDictionaries: ''
  2814.     category: 'Public Domain-Testing-Trees'!
  2815. TesterSKTreeLW comment:
  2816. 'Test suite for SKTreeLW.'!
  2817.  
  2818.  
  2819. !TesterSKTreeLW methodsFor: 'accessing misc'!
  2820.  
  2821. atInclusivePath: aPath 
  2822.     "The receiver tree instance is supposed to be part of the path."
  2823.  
  2824.     self
  2825.         comment: ["Incorrect path."]
  2826.         test: [(SKTreeLW key: 1) makeBranch atInclusivePath: #(2 )]
  2827.         expectError: 'Path is inaccessable.'.
  2828.     self
  2829.         comment: ["Leaves do not have paths."]
  2830.         test: [(SKTreeLW key: 1) atInclusivePath: #(1 )]
  2831.         expectError: 'Path is inaccessable.'.
  2832.     self
  2833.         comment: ["Accessing last node in an inclusive path."]
  2834.         test: 
  2835.             [| t |
  2836.             t := SKTreeLW key: 1.
  2837.             t addPath: #(2 3 ).
  2838.             t atInclusivePath: #(1 2 3 )]
  2839.         expectResult: '
  2840. 3'!
  2841.  
  2842. atInclusivePath: aPath ifAbsent: aBlock 
  2843.     "Already tested by the <atInclusivePath:> method."!
  2844.  
  2845. atKey: aKey 
  2846.     self
  2847.         comment: []
  2848.         test: 
  2849.             [| t |
  2850.             t := SKTreeLW key: 1.
  2851.             t addKey: 2.
  2852.             t atKey: 3]
  2853.         expectError: 'Key not found.'.
  2854.     self
  2855.         comment: ["May access the tree at a key in the subtrees collection."]
  2856.         test: 
  2857.             [| t |
  2858.             t := SKTreeLW key: $a.
  2859.             t add: (SKTreeLW key: $b); add: (SKTreeLW key: $c).
  2860.             t atKey: $b]
  2861.         expectResult: '
  2862. b'!
  2863.  
  2864. atKey: aKey ifAbsent: aBlock 
  2865.     "Already tested by the <atKey:> method."!
  2866.  
  2867. atPath: aPath 
  2868.     self
  2869.         comment: ["A path should be a sequenceable collection of keys. Here it is an 
  2870.             integer."]
  2871.         test: 
  2872.             [| t |
  2873.             t := SKTreeLW key: 1.
  2874.             t addPath: #(2 3 ).
  2875.             t atPath: 2]
  2876.         expectError: 'Message not understood: #do:'.
  2877.     self
  2878.         comment: ["This path doesn't exist."]
  2879.         test: 
  2880.             [| t |
  2881.             t := SKTreeLW key: 1.
  2882.             t addPath: #(2 3 ).
  2883.             t atPath: #(2 3 4 )]
  2884.         expectError: 'Path is inaccessable.'.
  2885.     self
  2886.         comment: ["A leaf has no path to access."]
  2887.         test: 
  2888.             [| t |
  2889.             t := SKTreeLW key: 1.    "This is a leaf node."
  2890.             t atPath: #()]
  2891.         expectError: 'Path is inaccessable.'.
  2892.     self
  2893.         comment: ["May access a node at a path relative to a tree."]
  2894.         test: 
  2895.             [| t |
  2896.             t := SKTreeLW key: 1.
  2897.             t addPath: #(2 3 4 ).
  2898.             t atPath: #(2 3 )]
  2899.         expectResult: '
  2900. 3\
  2901. . . .    4'!
  2902.  
  2903. atPath: aPath ifAbsent: aBlock 
  2904.     "Already tested by the <atPath:> method."!
  2905.  
  2906. atPath: aPath ifAbsentLeaf: block1 ifAbsentBranch: block2 
  2907.     self
  2908.         comment: ["Demonstrates the various possible responses."]
  2909.         test: 
  2910.             [| t u v w x |
  2911.             t := SKTreeLW rootFromPath: #(1 2 3 ).
  2912.             u := t atPath: #(2 ) ifAbsentLeaf: [$L] ifAbsentBranch: [$B].
  2913.             v := t atPath: #(2 3 ) ifAbsentLeaf: [$L] ifAbsentBranch: [$B].
  2914.             w := t atPath: #(2 4 ) ifAbsentLeaf: [$L] ifAbsentBranch: [$B].
  2915.             x := t atPath: #(2 3 4 ) ifAbsentLeaf: [$L] ifAbsentBranch: [$B].
  2916.             Array with: u with: v with: w with: x]
  2917.         expectResult: '#(
  2918. 2\
  2919. . . .    3 
  2920. 3 $B $L )'!
  2921.  
  2922. fullPathKeys
  2923.     self
  2924.         comment: ["May access the keys along a full path."]
  2925.         test: 
  2926.             [| t |
  2927.             t := SKPTreeLW leafFromPath: #(1 2 3 ).
  2928.             t fullPathKeys]
  2929.         expectResult: '#(1 2 3 )'!
  2930.  
  2931. keys
  2932.     self
  2933.         comment: ["Accessing the keys of the subtrees. SortedColl is just for fun."]
  2934.         test: 
  2935.             [| t |
  2936.             t := SKTreeLW key: $a subTrees: SortedCollection.
  2937.             t addKeys: 'bc'.
  2938.             t keys]
  2939.         expectResult: 'SortedCollection ($b $c )'!
  2940.  
  2941. rootlessPathKeys
  2942.     self
  2943.         comment: ["May access the keys along a rootless path."]
  2944.         test: 
  2945.             [| t |
  2946.             t := SKPTreeLW leafFromPath: #(1 2 3 ).
  2947.             t rootlessPathKeys]
  2948.         expectResult: '#(2 3 )'! !
  2949.  
  2950. !TesterSKTreeLW methodsFor: 'comparing'!
  2951.  
  2952. < aTree 
  2953.     self
  2954.         comment: ["Comparison depends on the keys alone."]
  2955.         test: 
  2956.             [| t1 t2 |
  2957.             t1 := SKTreeLW key: 1.
  2958.             t2 := SKTreeLW key: 2.
  2959.             Array with: t1 < t2 with: t2 < t1]
  2960.         expectResult: '#(true false )'!
  2961.  
  2962. <= aTree 
  2963.     self
  2964.         comment: ["Comparison depends on the keys alone."]
  2965.         test: 
  2966.             [| t1 t2 |
  2967.             t1 := SKTreeLW key: 1.
  2968.             t2 := SKTreeLW key: 2.
  2969.             Array with: t1 <= t2 with: t1 <= t1 with: t2 <= t1]
  2970.         expectResult: '#(true true false )'!
  2971.  
  2972. = aTree 
  2973.     self
  2974.         comment: ["Two trees are equal if their keys are equal."]
  2975.         test: 
  2976.             [| t u v |
  2977.             t := SKTreeLW key: 1 subTrees: Set.
  2978.             u := SKPVTreeLW key: 1 value: 2 subTrees: Array.
  2979.             v := SKTreeLW key: 0 subTrees: Set.
  2980.             Array with: t = u with: t = v]
  2981.         expectResult: '#(true false )'!
  2982.  
  2983. hash
  2984.     self
  2985.         comment: ["Hash depends on the key alone."]
  2986.         test: 
  2987.             [(SKTreeLW key: 1) hash]
  2988.         expectResult: '1'! !
  2989.  
  2990. !TesterSKTreeLW methodsFor: 'adding'!
  2991.  
  2992. addKey: aKey 
  2993.     self
  2994.         comment: ["You can add a tree by specifying its key."]
  2995.         test: 
  2996.             [| t u |
  2997.             t := SKTreeLW key: 1.
  2998.             u := t addKey: 2.
  2999.             Array with: u with: t]
  3000.         expectResult: '#(2 
  3001. 1\
  3002. . . .    2 )'!
  3003.  
  3004. addKeys: collOfKeys 
  3005.     self
  3006.         comment: ["Argument must be a collection of keys."]
  3007.         test: 
  3008.             [| t |
  3009.             t := SKTreeLW key: 1.
  3010.             t addKeys: 2]
  3011.         expectError: 'Message not understood: #do:'.
  3012.     self
  3013.         comment: ["A valid example of adding three keys."]
  3014.         test: 
  3015.             [| t u |
  3016.             t := SKTreeLW key: 1.
  3017.             u := t addKeys: #(2 3 4 ).
  3018.             t simplePrintStringLW , String crLW , u simplePrintStringLW]
  3019.         expectResult: '
  3020. 1\
  3021. . . .    2
  3022. . . .    3
  3023. . . .    4
  3024. #(2 3 4 )'!
  3025.  
  3026. addPath: aPath 
  3027.     self
  3028.         comment: ["Argument must be a sequenceable collection of keys."]
  3029.         test: 
  3030.             [| t |
  3031.             t := SKTreeLW key: 1.
  3032.             t addPath: 2]
  3033.         expectError: 'Message not understood: #do:'.
  3034.     self
  3035.         comment: ["When you add a path of keys to a tree the returned value is assoc: 
  3036.             (number of nodes added)->(leaf node added)."]
  3037.         test: 
  3038.             [| t u |
  3039.             t := SKTreeLW key: 1.
  3040.             u := t addPath: #(2 3 ).
  3041.             t simplePrintStringLW , String crLW , u simplePrintStringLW]
  3042.         expectResult: '
  3043. 1\
  3044. . . .    2\
  3045. . . .    . . .    3
  3046. 2->
  3047. 3'! !
  3048.  
  3049. !TesterSKTreeLW methodsFor: 'removing'!
  3050.  
  3051. removeKey: aKey 
  3052.     self
  3053.         comment: ["Cannot remove a key you do not have."]
  3054.         test: 
  3055.             [| t |
  3056.             t := SKTreeLW key: 1.
  3057.             t addKey: 2.
  3058.             t removeKey: 3]
  3059.         expectError: 'Key not found.'.
  3060.     self
  3061.         comment: ["Here's how to do it."]
  3062.         test: 
  3063.             [| s t u |
  3064.             t := SKTreeLW key: 1 subTrees: Array.
  3065.             t addKeys: #(2 3 ).
  3066.             u := t copy.
  3067.             s := u removeKey: 2.
  3068.             Array with: s with: t with: u]
  3069.         expectResult: '#(2 
  3070. 1\
  3071. . . .    2
  3072. . . .    3 
  3073. 1\
  3074. . . .    3 )'!
  3075.  
  3076. removeKey: aKey ifAbsent: aBlock 
  3077.     "Already tested by the <removeKey:> method."!
  3078.  
  3079. removeKeys: collOfKeys 
  3080.     self
  3081.         comment: ["You must have all the keys."]
  3082.         test: 
  3083.             [| t |
  3084.             t := SKTreeLW key: 1.
  3085.             t addKeys: #(2 3 ).
  3086.             t removeKeys: #(2 4 )]
  3087.         expectError: 'Key not found.'.
  3088.     self
  3089.         comment: ["Here's how to remove a collection of trees specified by their keys 
  3090.             from the subtrees collection."]
  3091.         test: 
  3092.             [| s t u |
  3093.             t := SKTreeLW key: 1.
  3094.             t addKeys: #(2 3 4 ).
  3095.             u := t copy.
  3096.             s := u removeKeys: #(2 3 ).
  3097.             Array with: s with: t with: u]
  3098.         expectResult: '#(#(2 3 ) 
  3099. 1\
  3100. . . .    2
  3101. . . .    3
  3102. . . .    4 
  3103. 1\
  3104. . . .    4 )'!
  3105.  
  3106. removePath: aPath 
  3107.     self
  3108.         comment: ["Cannot remove a path you do not have."]
  3109.         test: 
  3110.             [| t |
  3111.             t := SKTreeLW key: 1.
  3112.             t addPath: #(2 3 ).
  3113.             t removePath: #(2 3 4 )]
  3114.         expectError: 'Path is inaccessable.'.
  3115.     self
  3116.         comment: ["Here's how to remove a node specified by a path from a tree."]
  3117.         test: 
  3118.             [| s t u |
  3119.             t := SKTreeLW key: 1 subTrees: Array.
  3120.             t addPath: #(2 3 ); addPath: #(3 4 ).
  3121.             u := t copy.
  3122.             s := u removePath: #(2 3 ).
  3123.             Array with: s with: t with: u]
  3124.         expectResult: '#(#(2 3 ) 
  3125. 1\
  3126. . . .    2\
  3127. . . .    . . .    3
  3128. . . .    3\
  3129. . . .    . . .    4 
  3130. 1\
  3131. . . .    2\
  3132. . . .    3\
  3133. . . .    . . .    4 )'!
  3134.  
  3135. removePath: aPath ifAbsent: aBlock 
  3136.     "Already tested by the <removePath:> method."! !
  3137.  
  3138. !TesterSKTreeLW methodsFor: 'testing misc'!
  3139.  
  3140. hasSamePathAs: aTree 
  3141.     self
  3142.         comment: ["The argument must be a tree."]
  3143.         test: [(SKTreeLW key: 1) hasSamePathAs: #(1 )]
  3144.         expectError: 'Message not understood: #key'.
  3145.     self
  3146.         comment: ["A tree with superTree pointer can calculate its path from the root."]
  3147.         test: 
  3148.             [| t u |
  3149.             t := SKPTreeLW leafFromPath: #(1 2 3 ).
  3150.             u := SKPTreeLW leafFromPath: #(1 2 3 ).
  3151.             Array with: (t hasSamePathAs: u) with: (t hasSamePathAs: u superTree)]
  3152.         expectResult: '#(true false )'.
  3153.     self
  3154.         comment: ["A tree without superTree pointer is a root and its key is the single 
  3155.             element of its path."]
  3156.         test: 
  3157.             [| t u v |
  3158.             t := SKTreeLW leafFromPath: #(1 2 3 ).
  3159.             u := SKTreeLW leafFromPath: #(3 ).
  3160.             v := SKTreeLW leafFromPath: #(2 ).
  3161.             Array with: (t hasSamePathAs: u) with: (t hasSamePathAs: v)]
  3162.         expectResult: '#(true false )'!
  3163.  
  3164. includesInclusivePath: aPath 
  3165.     self
  3166.         comment: ["Argument must be a sequenceable collection of keys."]
  3167.         test: 
  3168.             [| t |
  3169.             t := SKTreeLW key: 1.
  3170.             t addPath: #(2 3 ).
  3171.             t includesInclusivePath: 2]
  3172.         expectError: 'Message not understood: #isEmpty'.
  3173.     self
  3174.         comment: ["Here's how you test for a node at an inclusive path."]
  3175.         test: 
  3176.             [| t |
  3177.             t := SKTreeLW rootFromPath: #(1 2 3 ).
  3178.             Array
  3179.                     with: (t includesInclusivePath: #(1 2 3 ))
  3180.                     with: (t includesInclusivePath: #(1 2 4 ))]
  3181.         expectResult: '#(true false )'!
  3182.  
  3183. includesKey: aKey 
  3184.     self
  3185.         comment: ["Can test whether a tree with a specified key is in the subtrees 
  3186.             collection."]
  3187.         test: 
  3188.             [| t |
  3189.             t := SKTreeLW rootFromPath: #(1 2 ).
  3190.             Array with: (t includesKey: 2) with: (t includesKey: 3)]
  3191.         expectResult: '#(true false )'!
  3192.  
  3193. includesPath: aPath 
  3194.     self
  3195.         comment: ["Argument must be a sequenceable collection of keys."]
  3196.         test: 
  3197.             [| t |
  3198.             t := SKTreeLW key: 1.
  3199.             t addPath: #(2 3 ).
  3200.             t includesPath: 2]
  3201.         expectError: 'Message not understood: #do:'.
  3202.     self
  3203.         comment: ["Here's how to test whether a path from a node exists."]
  3204.         test: 
  3205.             [| t |
  3206.             t := SKTreeLW rootFromPath: #(1 2 3 ).
  3207.             Array with: (t includesPath: #(2 3 )) with: (t includesPath: #(2 4 ))]
  3208.         expectResult: '#(true false )'! !
  3209.  
  3210. !TesterSKTreeLW methodsFor: 'printing misc'!
  3211.  
  3212. fullPathString
  3213.     self
  3214.         comment: ["A string describing the full path to a node."]
  3215.         test: [(SKPTreeLW leafFromPath: #(1 2 3 4 )) fullPathString]
  3216.         expectResult: '1\2\3\4'.
  3217.     self
  3218.         comment: ["Same thing, except the tree does not maintain a superTree pointer."]
  3219.         test: [(SKTreeLW leafFromPath: #(1 2 3 4 )) fullPathString]
  3220.         expectResult: '4'!
  3221.  
  3222. immediatePathString
  3223.     self
  3224.         comment: ["A string describing the path from a node's supertree to the node."]
  3225.         test: [(SKPTreeLW leafFromPath: #(1 2 3 4 )) immediatePathString]
  3226.         expectResult: '3\4'.
  3227.     self
  3228.         comment: ["Same thing, but the tree does not maintain a superTree pointer."]
  3229.         test: [(SKTreeLW leafFromPath: #(1 2 3 4 )) immediatePathString]
  3230.         expectResult: '4'.!
  3231.  
  3232. rootlessPathString
  3233.     self
  3234.         comment: ["String describing path to a node, not including root."]
  3235.         test: [(SKPTreeLW leafFromPath: #(1 2 3 4 )) rootlessPathString]
  3236.         expectResult: '2\3\4'.
  3237.     self
  3238.         comment: ["Same thing, except the tree does not maintain a superTree pointer."]
  3239.         test: [(SKTreeLW leafFromPath: #(1 2 3 4 )) rootlessPathString]
  3240.         expectResult: ''!
  3241.  
  3242. stringFromPathKeys: aPath 
  3243.     self
  3244.         comment: ["A string describing a path derived from its keys."]
  3245.         test: [SKPVTreeLW basicNew stringFromPathKeys: #(1 2 3 )]
  3246.         expectResult: '1\2\3'!
  3247.  
  3248. stringFromPathKeys: aPath separator: separatorChar 
  3249.     self
  3250.         comment: ["Using an arbitrary separator here."]
  3251.         test: [SKPVTreeLW basicNew stringFromPathKeys: #(1 2 3 ) separator: $|]
  3252.         expectResult: '1|2|3'!
  3253.  
  3254. stringFromPathNodes: aPath
  3255.     self
  3256.         comment: ["In the first tree the last node is a leaf; in the second it is a branch."]
  3257.         test: 
  3258.             [| t u v |
  3259.             t := SKPVTreeLW key: 1.
  3260.             u := SKPVTreeLW key: 2.
  3261.             v := SKPVTreeLW key: 3.
  3262.             t add: u.
  3263.             u add: v.
  3264.             (t stringFromPathNodes: (Array with: t with: u with: v)) ,
  3265.             String crLW ,
  3266.             (t stringFromPathNodes: (Array with: t with: u with: v copy makeBranch))]
  3267.         expectResult: '1\2\3
  3268. 1\2\3\'! !
  3269.  
  3270. !TesterSKTreeLW methodsFor: 'private accessing'!
  3271.  
  3272. basicKey
  3273.     self
  3274.         comment: ["We use SKTreeLW because there is no KTreeLW. Testing <key> 
  3275.             implicitly tests <basicKey>."]
  3276.         test: [(SKTreeLW key: 1) key]
  3277.         expectResult: '1'!
  3278.  
  3279. basicKey: aKey 
  3280.     "The <basicKey:> method is implicitly tested by <basicKey>."! !
  3281.  
  3282. !TesterSKTreeLW methodsFor: 'private validating'!
  3283.  
  3284. validateSubTreesClass: aClass 
  3285.  
  3286.     self
  3287.         comment: ["This class is not valid."]
  3288.         test: [SKTreeLW new validateSubTreesClass: Dictionary]
  3289.         expectError: 'The subtrees specification is illegal.'.
  3290.  
  3291.     (Array
  3292.         with: OrderedCollection
  3293.         with: Array
  3294.         with: Set
  3295.         with: SortedCollection)
  3296.         do: [:cl | self
  3297.                 comment: ["These classes are valid."]
  3298.                 test: [(SKTreeLW new) validateSubTreesClass: cl; yourself]
  3299.                 expectResult: '
  3300. node']! !
  3301. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3302.  
  3303. TesterSKTreeLW class
  3304.     instanceVariableNames: ''!
  3305.  
  3306.  
  3307. !TesterSKTreeLW class methodsFor: 'instance creation'!
  3308.  
  3309. leafFromPath: aPath 
  3310.     self
  3311.         comment: ["May create a whole path at once and return its leaf node."]
  3312.         test: [SKTreeLW leafFromPath: #(1 2 3 )]
  3313.         expectResult: '
  3314. 3'!
  3315.  
  3316. rootFromPath: aPath 
  3317.     self
  3318.         comment: ["Path cannot be empty."]
  3319.         test: [SKTreeLW rootFromPath: #()]
  3320.         expectError: 'this collection is empty'.
  3321.     self
  3322.         comment: ["May create a whole path at once and return its root node."]
  3323.         test: [SKTreeLW rootFromPath: 'abc']
  3324.         expectResult: '
  3325. a\
  3326. . . .    b\
  3327. . . .    . . .    c'! !
  3328.  
  3329. TesterForTreesLW subclass: #TesterSKVTreeLW
  3330.     instanceVariableNames: ''
  3331.     classVariableNames: ''
  3332.     poolDictionaries: ''
  3333.     category: 'Public Domain-Testing-Trees'!
  3334. TesterSKVTreeLW comment:
  3335. 'Test suite for SKVTreeLW.'!
  3336.  
  3337.  
  3338. !TesterSKVTreeLW methodsFor: 'private accessing'!
  3339.  
  3340. privateAccessing
  3341.     "See the tests in VTreeLW. There is nothing new to add here."! !
  3342.  
  3343. TesterForTreesLW subclass: #TesterSPTreeLW
  3344.     instanceVariableNames: ''
  3345.     classVariableNames: ''
  3346.     poolDictionaries: ''
  3347.     category: 'Public Domain-Testing-Trees'!
  3348. TesterSPTreeLW comment:
  3349. 'Test suite for SPTreeLW.'!
  3350.  
  3351.  
  3352. !TesterSPTreeLW methodsFor: 'private accessing'!
  3353.  
  3354. privateAccessing
  3355.     "See the tests in PTreeLW. There is nothing new to add here."! !
  3356.  
  3357. TesterForTreesLW subclass: #TesterSPVTreeLW
  3358.     instanceVariableNames: ''
  3359.     classVariableNames: ''
  3360.     poolDictionaries: ''
  3361.     category: 'Public Domain-Testing-Trees'!
  3362. TesterSPVTreeLW comment:
  3363. 'Test suite for SPVTreeLW.'!
  3364.  
  3365.  
  3366. !TesterSPVTreeLW methodsFor: 'private accessing'!
  3367.  
  3368. privateAccessing
  3369.     "See the tests in VTreeLW. There is nothing new to add here."! !
  3370.  
  3371. TesterForTreesLW subclass: #TesterSTreeLW
  3372.     instanceVariableNames: ''
  3373.     classVariableNames: ''
  3374.     poolDictionaries: ''
  3375.     category: 'Public Domain-Testing-Trees'!
  3376. TesterSTreeLW comment:
  3377. 'Test suite for STreeLW.'!
  3378.  
  3379.  
  3380. !TesterSTreeLW methodsFor: 'accessing simple'!
  3381.  
  3382. subTrees
  3383.     self
  3384.         comment: ["This tree has two subtrees."]
  3385.         test: 
  3386.             [| t |
  3387.             t := SKPVTreeLW subTrees: Array.
  3388.             t addKeys: 'bc'.
  3389.             t subTrees]
  3390.         expectResult: '#(
  3391. c )'! !
  3392.  
  3393. !TesterSTreeLW methodsFor: 'accessing misc'!
  3394.  
  3395. atIndex: anIndex 
  3396.     self
  3397.         comment: ["Cannot access a set of subtrees via an index."]
  3398.         test: 
  3399.             [| t |
  3400.             t := SKTreeLW key: 1 subTrees: Set.
  3401.             t addKey: 2.
  3402.             t atIndex: 1]
  3403.         expectError: 'Sets do not respond to keyed accessing messages.'.
  3404.     self
  3405.         comment: ["Index out of range."]
  3406.         test: 
  3407.             [| t |
  3408.             t := SKTreeLW key: 1 subTrees: Array.
  3409.             t addKey: 2.
  3410.             t atIndex: 10]
  3411.         expectError: 'Subscript out of bounds: 10'.
  3412.     self
  3413.         comment: ["May access the node at an index if the subtrees are stored in a 
  3414.             sequenceable collection."]
  3415.         test: 
  3416.             [| t |
  3417.             t := SKTreeLW new.
  3418.             t add: (SKTreeLW key: $a); add: (SKTreeLW key: $b).
  3419.             t atIndex: 1]
  3420.         expectResult: '
  3421. a'!
  3422.  
  3423. atIndex: anIndex put: aTree 
  3424.     self
  3425.         comment: ["Both trees must either define or not define a superTrees pointer."]
  3426.         test: 
  3427.             [| t |
  3428.             t := SKTreeLW key: 1 subTrees: Array.
  3429.             t addKey: 2.
  3430.             t atIndex: 1 put: (SKPTreeLW key: 3)]
  3431.         expectError: 'Attempt to connect incompatible trees.'.
  3432.     self
  3433.         comment: ["Cannot store into an index of a sorted collection."]
  3434.         test: 
  3435.             [| t |
  3436.             t := SKTreeLW key: 1 subTrees: SortedCollection.
  3437.             t addKey: 2.
  3438.             t atIndex: 1 put: (SKTreeLW key: 3)]
  3439.         expectError: 'to add to a sorted collection, you must use add:'.
  3440.     self
  3441.         comment: ["May store a tree at an index in the subtrees collection if it is 
  3442.             sequenceable. The previous tree at this index gets replaced."]
  3443.         test: 
  3444.             [| t u |
  3445.             t := SKTreeLW key: $a subTrees: Array.
  3446.             t add: (SKTreeLW key: $b).
  3447.             u := t atIndex: 1 put: (SKTreeLW key: $c).
  3448.             t simplePrintStringLW , String crLW , u simplePrintStringLW]
  3449.         expectResult: '
  3450. a\
  3451. . . .    c
  3452.  
  3453. c'! !
  3454.  
  3455. !TesterSTreeLW methodsFor: 'adding'!
  3456.  
  3457. add: aTree 
  3458.     self
  3459.         comment: ["The object you add must be a tree."]
  3460.         test: 
  3461.             [| t |
  3462.             t := STreeLW new.
  3463.             t add: 1]
  3464.         expectError: 'Expecting a tree.'.
  3465.     self
  3466.         comment: ["Cannot add a tree defining a superTree pointer to a tree not defining one."]
  3467.         test: 
  3468.             [| t |
  3469.             t := STreeLW new.
  3470.             t add: SPTreeLW new]
  3471.         expectError: 'Attempt to connect incompatible trees.'.
  3472.     self
  3473.         comment: ["Here is a valid way to add a tree to the subtrees collection of 
  3474.             another tree."]
  3475.         test: 
  3476.             [| t u v |
  3477.             t := SKPVTreeLW key: 1.
  3478.             u := SKPVTreeLW key: 2.
  3479.             v := t add: u.
  3480.             Array with: t with: v]
  3481.         expectResult: '#(
  3482. 1\
  3483. . . .    2 
  3484. 2 )'!
  3485.  
  3486. addAll: collOfTrees 
  3487.     self
  3488.         comment: ["Each tree you add must be valid."]
  3489.         test: 
  3490.             [| t |
  3491.             t := STreeLW new.
  3492.             t addAll: (Array with: STreeLW new with: SPTreeLW new)]
  3493.         expectError: 'Attempt to connect incompatible trees.'.
  3494.     self
  3495.         comment: ["Here is a valid example of adding two trees."]
  3496.         test: 
  3497.             [| t u v |
  3498.             t := SKPVTreeLW key: 1 subTrees: Array.
  3499.             u := Array with: (SKPVTreeLW key: 2) with: (SKPVTreeLW key: 3).
  3500.             v := t addAll: u.
  3501.             Array with: v with: t]
  3502.         expectResult: '#(#(
  3503. 3 ) 
  3504. 1\
  3505. . . .    2
  3506. . . .    3 )'! !
  3507.  
  3508. !TesterSTreeLW methodsFor: 'removing'!
  3509.  
  3510. detach
  3511.     self
  3512.         comment: ["After detaching u, t is an empty branch, u is a leaf, and u has 
  3513.             become a root."]
  3514.         test: 
  3515.             [| t u |
  3516.             t := SKPTreeLW key: 1.
  3517.             u := SKPTreeLW key: 2.
  3518.             t add: u.
  3519.             u detach.
  3520.             Array with: t with: u with: u isRoot]
  3521.         expectResult: '#(
  3522. 1\ 
  3523. 2 true )'!
  3524.  
  3525. prune
  3526.     self
  3527.         comment: ["Branch 7 was unproductive and got removed. Branch 11 did not get 
  3528.             removed because you must use recursivePrune to operate recursively."]
  3529.         test: 
  3530.             [| t u |
  3531.             t := SKTreeLW example3: OrderedCollection.
  3532.             u := t recursiveCopy.
  3533.             u prune.
  3534.             t simplePrintStringLW , String crLW , u simplePrintStringLW]
  3535.         expectResult: '
  3536. 1\
  3537. . . .    2\
  3538. . . .    . . .    3
  3539. . . .    . . .    4
  3540. . . .    . . .    5
  3541. . . .    6
  3542. . . .    7\
  3543. . . .    8\
  3544. . . .    . . .    9
  3545. . . .    . . .    10\
  3546. . . .    . . .    . . .    11\
  3547. . . .    . . .    . . .    . . .    12\
  3548. . . .    . . .    . . .    13
  3549.  
  3550. 1\
  3551. . . .    2\
  3552. . . .    . . .    3
  3553. . . .    . . .    4
  3554. . . .    . . .    5
  3555. . . .    6
  3556. . . .    8\
  3557. . . .    . . .    9
  3558. . . .    . . .    10\
  3559. . . .    . . .    . . .    11\
  3560. . . .    . . .    . . .    . . .    12\
  3561. . . .    . . .    . . .    13'!
  3562.  
  3563. recursivePrune
  3564.     self
  3565.         comment: ["Branches 7 and 11 were unproductive and got recursively pruned."]
  3566.         test: 
  3567.             [| t u |
  3568.             t := SKTreeLW example3: OrderedCollection.
  3569.             u := t recursiveCopy.
  3570.             u recursivePrune.
  3571.             t simplePrintStringLW , String crLW , u simplePrintStringLW]
  3572.         expectResult: '
  3573. 1\
  3574. . . .    2\
  3575. . . .    . . .    3
  3576. . . .    . . .    4
  3577. . . .    . . .    5
  3578. . . .    6
  3579. . . .    7\
  3580. . . .    8\
  3581. . . .    . . .    9
  3582. . . .    . . .    10\
  3583. . . .    . . .    . . .    11\
  3584. . . .    . . .    . . .    . . .    12\
  3585. . . .    . . .    . . .    13
  3586.  
  3587. 1\
  3588. . . .    2\
  3589. . . .    . . .    3
  3590. . . .    . . .    4
  3591. . . .    . . .    5
  3592. . . .    6
  3593. . . .    8\
  3594. . . .    . . .    9
  3595. . . .    . . .    10\
  3596. . . .    . . .    . . .    13'!
  3597.  
  3598. recursiveRemoveTreesSatisfying: aBlock 
  3599.     self
  3600.         comment: ["The trees with odd keys get removed, along with their subtrees."]
  3601.         test: 
  3602.             [| t u |
  3603.             t := SKTreeLW example3: OrderedCollection.
  3604.             u := t recursiveCopy recursiveRemoveTreesSatisfying: [:tree | tree key odd].
  3605.             t simplePrintStringLW , String crLW , u simplePrintStringLW]
  3606.         expectResult: '
  3607. 1\
  3608. . . .    2\
  3609. . . .    . . .    3
  3610. . . .    . . .    4
  3611. . . .    . . .    5
  3612. . . .    6
  3613. . . .    7\
  3614. . . .    8\
  3615. . . .    . . .    9
  3616. . . .    . . .    10\
  3617. . . .    . . .    . . .    11\
  3618. . . .    . . .    . . .    . . .    12\
  3619. . . .    . . .    . . .    13
  3620.  
  3621. 1\
  3622. . . .    2\
  3623. . . .    . . .    4
  3624. . . .    6
  3625. . . .    8\
  3626. . . .    . . .    10\'!
  3627.  
  3628. remove: aTree 
  3629.     self
  3630.         comment: ["Cannot remove a tree you do not have."]
  3631.         test: 
  3632.             [| t |
  3633.             t := SKTreeLW key: 1.
  3634.             t add: (SKTreeLW key: 2).
  3635.             t remove: (SKTreeLW key: 3)]
  3636.         expectError: 'Tree not found.'.
  3637.     self
  3638.         comment: ["Cannot remove from a leaf."]
  3639.         test: 
  3640.             [| t |
  3641.             t := SKTreeLW key: 1.
  3642.             t remove: (SKTreeLW key: 1)]
  3643.         expectError: 'Tree not found.'.
  3644.     self
  3645.         comment: ["Valid example of removing a tree."]
  3646.         test: 
  3647.             [| t u v |
  3648.             t := SKTreeLW key: 1 subTrees: Array.
  3649.             t addKeys: #(2 3 ).
  3650.             u := t copy.
  3651.             v := u remove: (SKTreeLW key: 2).
  3652.             Array with: t with: u with: v]
  3653.         expectResult: '#(
  3654. 1\
  3655. . . .    2
  3656. . . .    3 
  3657. 1\
  3658. . . .    3 
  3659. 2 )'!
  3660.  
  3661. remove: aTree ifAbsent: aBlock 
  3662.     "Already tested by the <remove:> method."!
  3663.  
  3664. removeAll: collOfTrees 
  3665.     self
  3666.         comment: ["You must have all the specified subtrees."]
  3667.         test: 
  3668.             [| t |
  3669.             t := SKTreeLW key: 1.
  3670.             t add: (SKTreeLW key: 2).
  3671.             t add: (SKTreeLW key: 3).
  3672.             t removeAll: (Array with: (SKTreeLW key: 2) with: (SKTreeLW key: 4))]
  3673.         expectError: 'Tree not found.'.
  3674.     self
  3675.         comment: ["Here's how to remove a collection of trees from the subtrees 
  3676.             collection."]
  3677.         test: 
  3678.             [| s t u |
  3679.             t := SKTreeLW key: 1.
  3680.             t addKeys: #(2 3 4 ).
  3681.             u := t copy.
  3682.             s := u removeAll: (Array with: (SKTreeLW key: 2) with: (SKTreeLW key: 3)).
  3683.             Array with: s with: t with: u]
  3684.         expectResult: '#(#(
  3685. 3 ) 
  3686. 1\
  3687. . . .    2
  3688. . . .    3
  3689. . . .    4 
  3690. 1\
  3691. . . .    4 )'!
  3692.  
  3693. removeTreesSatisfying: aBlock 
  3694.     self
  3695.         comment: ["This removes trees from the subtrees collection, but not recursively."]
  3696.         test: 
  3697.             [| t u |
  3698.             t := SKTreeLW key: 1 subTrees: Array.
  3699.             t addPath: #(2 3 ); addPath: #(3 4 ).
  3700.             u := t copy.
  3701.             u removeTreesSatisfying: [:tree | tree key odd].
  3702.             Array with: t with: u]
  3703.         expectResult: '#(
  3704. 1\
  3705. . . .    2\
  3706. . . .    . . .    3
  3707. . . .    3\
  3708. . . .    . . .    4 
  3709. 1\
  3710. . . .    2\
  3711. . . .    . . .    3 )'! !
  3712.  
  3713. !TesterSTreeLW methodsFor: 'testing misc'!
  3714.  
  3715. isLeaf
  3716.     self
  3717.         comment: ["A tree knows whether it is a branch or leaf."]
  3718.         test: [Array
  3719.                     with: STreeLW new isLeaf
  3720.                     with: STreeLW new makeBranch isLeaf]
  3721.         expectResult: '#(true false )'! !
  3722.  
  3723. !TesterSTreeLW methodsFor: 'enumerating'!
  3724.  
  3725. recursiveSelect: aBlock inclusive: boolean 
  3726.     self
  3727.         comment: ["Display 
  3728.             the original tree 
  3729.             recursiveSelect with the root node included and failing 
  3730.             recursiveSelect with the root node excluded 
  3731.             recursiveSelect with the root node included and passing."]
  3732.         test: 
  3733.             [| t u v w |
  3734.             t := SKTreeLW example3: Array.
  3735.             u := t recursiveSelect: [:aTree | aTree key even] inclusive: true.
  3736.             v := t recursiveSelect: [:aTree | aTree key even] inclusive: false.
  3737.             w := t recursiveSelect: [:aTree | aTree key = 1 | aTree key even] inclusive: true.
  3738.             Array with: t with: u with: v with: w]
  3739.         expectResult: '#(
  3740. 1\
  3741. . . .    2\
  3742. . . .    . . .    3
  3743. . . .    . . .    4
  3744. . . .    . . .    5
  3745. . . .    6
  3746. . . .    7\
  3747. . . .    8\
  3748. . . .    . . .    9
  3749. . . .    . . .    10\
  3750. . . .    . . .    . . .    11\
  3751. . . .    . . .    . . .    . . .    12\
  3752. . . .    . . .    . . .    13 nil 
  3753. 1\
  3754. . . .    2\
  3755. . . .    . . .    4
  3756. . . .    6
  3757. . . .    8\
  3758. . . .    . . .    10\ 
  3759. 1\
  3760. . . .    2\
  3761. . . .    . . .    4
  3762. . . .    6
  3763. . . .    8\
  3764. . . .    . . .    10\ )'!
  3765.  
  3766. select: aBlock 
  3767.     self
  3768.         comment: ["This operates on the immediate subtrees."]
  3769.         test: 
  3770.             [| t u |
  3771.             t := SKTreeLW example4: SortedCollection.
  3772.             u := t select: [:aTree | aTree key > 2].
  3773.             Array with: t with: u]
  3774.         expectResult: '#(
  3775. 1\
  3776. . . .    2\
  3777. . . .    . . .    3
  3778. . . .    . . .    4
  3779. . . .    . . .    5
  3780. . . .    6 
  3781. 1\
  3782. . . .    6 )'! !
  3783.  
  3784. !TesterSTreeLW methodsFor: 'converting'!
  3785.  
  3786. clip
  3787.     self
  3788.         comment: ["Notice how v is a branch and w is a leaf."]
  3789.         test: 
  3790.             [| t u v w |
  3791.             t := SKTreeLW key: 1.
  3792.             u := t copy clip.
  3793.             v := t copy makeBranch.
  3794.             w := v copy clip.
  3795.             Array with: t with: u with: v with: w]
  3796.         expectResult: '#(
  3797. 1\ 
  3798. 1 )'!
  3799.  
  3800. makeBranch
  3801.     self
  3802.         comment: ["Notice that the result is a branch."]
  3803.         test: [STreeLW new makeBranch]
  3804.         expectResult: '
  3805. node\'!
  3806.  
  3807. makeLeaf
  3808.     self
  3809.         comment: ["In converting the tree to a leaf, its subtree gets removed."]
  3810.         test: 
  3811.             [| t |
  3812.             t := SKTreeLW rootFromPath: #(1 2 ).
  3813.             t makeLeaf]
  3814.         expectResult: '
  3815. 1'!
  3816.  
  3817. recursiveClip
  3818.     self
  3819.         comment: ["Notice how the branch node with key=3 gets converted to a leaf."]
  3820.         test: 
  3821.             [| t u v w |
  3822.             t := SKTreeLW key: 1 subTrees: Array.
  3823.             u := SKTreeLW key: 2.
  3824.             v := (SKTreeLW key: 3) makeBranch.
  3825.             t add: u; add: v.
  3826.             w := t copy recursiveClip.
  3827.             Array with: t with: w]
  3828.         expectResult: '#(
  3829. 1\
  3830. . . .    2
  3831. . . .    3\ 
  3832. 1\
  3833. . . .    2
  3834. . . .    3 )'!
  3835.  
  3836. recursiveSubTreesAs: collectionClass 
  3837.     self
  3838.         comment: ["Argument must be a collection class."]
  3839.         test: 
  3840.             [| t |
  3841.             t := SKTreeLW key: 1.
  3842.             t addKeys: #(2 3 ).
  3843.             t recursiveSubTreesAs: SKPTreeLW]
  3844.         expectError: 'The subtrees specification is illegal.'.
  3845.     self
  3846.         comment: ["We double the keys to eliminate hashing coincidences. Notice how 
  3847.             some of the sets have different orderings."]
  3848.         test: 
  3849.             [| t u |
  3850.             t := SKTreeLW example3: SortedCollection.
  3851.             t recursiveDo: [:tree | tree key: tree key * 2].
  3852.             u := t recursiveSubTreesAs: Set.
  3853.             Array
  3854.                 with: t
  3855.                 with: t subTrees class name
  3856.                 with: u
  3857.                 with: u subTrees class name]
  3858.         expectResult: '#(
  3859. 2\
  3860. . . .    4\
  3861. . . .    . . .    6
  3862. . . .    . . .    8
  3863. . . .    . . .    10
  3864. . . .    12
  3865. . . .    14\
  3866. . . .    16\
  3867. . . .    . . .    18
  3868. . . .    . . .    20\
  3869. . . .    . . .    . . .    22\
  3870. . . .    . . .    . . .    . . .    24\
  3871. . . .    . . .    . . .    26 #SortedCollection 
  3872. 2\
  3873. . . .    12
  3874. . . .    14\
  3875. . . .    4\
  3876. . . .    . . .    8
  3877. . . .    . . .    10
  3878. . . .    . . .    6
  3879. . . .    16\
  3880. . . .    . . .    18
  3881. . . .    . . .    20\
  3882. . . .    . . .    . . .    22\
  3883. . . .    . . .    . . .    . . .    24\
  3884. . . .    . . .    . . .    26 #Set )'!
  3885.  
  3886. subTreesAs: collectionClass 
  3887.     self
  3888.         comment: ["Cannot store subtrees in a dictionary."]
  3889.         test: 
  3890.             [| t |
  3891.             t := SKTreeLW key: 1.
  3892.             t addKeys: #(2 3 ).
  3893.             t subTreesAs: Dictionary]
  3894.         expectError: 'The subtrees specification is illegal.'.
  3895.     self
  3896.         comment: ["Converting a leaf node."]
  3897.         test: 
  3898.             [| t |
  3899.             t := (SKTreeLW key: 1 subTrees: SortedCollection) subTreesAs: Set.
  3900.             Array with: t with: t subTrees class name]
  3901.         expectResult: '#(
  3902. 1 #Set )'.
  3903.     self
  3904.         comment: ["Notice the difference between this and its recursive counterpart. 
  3905.             This only transforms the immediate subtrees collection."]
  3906.         test: 
  3907.             [| t u |
  3908.             t := SKTreeLW example3: SortedCollection.
  3909.             t recursiveDo: [:tree | tree key: tree key * 2].
  3910.             u := t subTreesAs: Set.
  3911.             Array
  3912.                 with: t
  3913.                 with: t subTrees class name
  3914.                 with: u
  3915.                 with: u subTrees class name]
  3916.         expectResult: '#(
  3917. 2\
  3918. . . .    4\
  3919. . . .    . . .    6
  3920. . . .    . . .    8
  3921. . . .    . . .    10
  3922. . . .    12
  3923. . . .    14\
  3924. . . .    16\
  3925. . . .    . . .    18
  3926. . . .    . . .    20\
  3927. . . .    . . .    . . .    22\
  3928. . . .    . . .    . . .    . . .    24\
  3929. . . .    . . .    . . .    26 #SortedCollection 
  3930. 2\
  3931. . . .    12
  3932. . . .    14\
  3933. . . .    4\
  3934. . . .    . . .    6
  3935. . . .    . . .    8
  3936. . . .    . . .    10
  3937. . . .    16\
  3938. . . .    . . .    18
  3939. . . .    . . .    20\
  3940. . . .    . . .    . . .    22\
  3941. . . .    . . .    . . .    . . .    24\
  3942. . . .    . . .    . . .    26 #Set )'! !
  3943.  
  3944. !TesterSTreeLW methodsFor: 'private initializing'!
  3945.  
  3946. defaultSubTrees
  3947.     "This is implicitly tested when a tree is created."! !
  3948.  
  3949. !TesterSTreeLW methodsFor: 'private accessing'!
  3950.  
  3951. privateAccessing
  3952.     "The <basicSubTrees> and <basicSubTrees:> methods implicitly get tested by 
  3953.     many other methods. We won't bother to write tests for them here."! !
  3954.  
  3955. !TesterSTreeLW methodsFor: 'private validating'!
  3956.  
  3957. validateSubTrees: aCollectionOrClass 
  3958.     "This method is implicitly tested by TesterTreeLW class>>subTrees:."! !
  3959.  
  3960. TesterForTreesLW subclass: #TesterSVTreeLW
  3961.     instanceVariableNames: ''
  3962.     classVariableNames: ''
  3963.     poolDictionaries: ''
  3964.     category: 'Public Domain-Testing-Trees'!
  3965. TesterSVTreeLW comment:
  3966. 'Test suite for SVTreeLW.'!
  3967.  
  3968.  
  3969. !TesterSVTreeLW methodsFor: 'private accessing'!
  3970.  
  3971. privateAccessing
  3972.     "See the tests in VTreeLW. There is nothing new to add here."! !
  3973.  
  3974. TesterForTreesLW subclass: #TesterTreeLW
  3975.     instanceVariableNames: ''
  3976.     classVariableNames: ''
  3977.     poolDictionaries: ''
  3978.     category: 'Public Domain-Testing-Trees'!
  3979. TesterTreeLW comment:
  3980. 'Test suite for TreeLW. Since TreeLW is an abstract class, we actually test concrete subclasses that can be instantiated.'!
  3981.  
  3982.  
  3983. !TesterTreeLW methodsFor: 'accessing simple'!
  3984.  
  3985. key
  3986.     self
  3987.         comment: ["Key is not defined by STreeLW."]
  3988.         test: [(STreeLW key: 1) key]
  3989.         expectResult: 'nil'.
  3990.     self
  3991.         comment: ["Key is defined by SKTreeLW."]
  3992.         test: [(SKTreeLW key: 1) key]
  3993.         expectResult: '1'!
  3994.  
  3995. key: aKey
  3996.     "Already tested by the class instance creation method."!
  3997.  
  3998. subTrees
  3999.     "The test for this is in TesterSTreeLW."!
  4000.  
  4001. subTrees: subTreesColl 
  4002.     "Already tested by the class instance creation method."!
  4003.  
  4004. superTree
  4005.     self
  4006.         comment: ["SuperTree is not defined by STreeLW."]
  4007.         test: [(STreeLW new add: STreeLW new) superTree]
  4008.         expectResult: 'nil'.
  4009.     self
  4010.         comment: ["SuperTree is defined by SKPTreeLW. A root tree has no supertree; 
  4011.             its subtrees have itself as supertree."]
  4012.         test: 
  4013.             [| t u |
  4014.             t := SKPTreeLW key: $a.
  4015.             u := SKPTreeLW key: $b.
  4016.             t add: u.
  4017.             t superTree simplePrintStringLW , String crLW , u superTree simplePrintStringLW]
  4018.         expectResult: 'none
  4019.  
  4020. a\
  4021. . . .    b'!
  4022.  
  4023. superTree: aTree 
  4024.     self
  4025.         comment: ["Clients cannot set the superTree pointer."]
  4026.         test: [SKPVTreeLW new superTree: SKPVTreeLW new]
  4027.         expectError: 'This message is not appropriate for this object'.!
  4028.  
  4029. value
  4030.     self
  4031.         comment: ["Value is not defined by STreeLW."]
  4032.         test: [(STreeLW value: 1) value]
  4033.         expectResult: 'nil'.
  4034.     self
  4035.         comment: ["Value is defined by SVTreeLW."]
  4036.         test: [(SVTreeLW value: 1) value]
  4037.         expectResult: '1'!
  4038.  
  4039. value: anObject 
  4040.     "Already tested by the class instance creation method."! !
  4041.  
  4042. !TesterTreeLW methodsFor: 'accessing misc'!
  4043.  
  4044. fullPathNodes
  4045.     self
  4046.         comment: ["You may access the nodes along a full path, returning a collection 
  4047.             of nodes."]
  4048.         test: 
  4049.             [| t |
  4050.             t := SKPVTreeLW leafFromPath: #(1 2 3 ).
  4051.             t fullPathNodes]
  4052.         expectResult: '#(
  4053. 1\
  4054. . . .    2\
  4055. . . .    . . .    3 
  4056. 2\
  4057. . . .    3 
  4058. 3 )'!
  4059.  
  4060. root
  4061.     self
  4062.         comment: ["A tree defining a superTree pointer can locate its root."]
  4063.         test: 
  4064.             [| t |
  4065.             t := SKPVTreeLW leafFromPath: #(1 2 3 ).
  4066.             t root]
  4067.         expectResult: '
  4068. 1\
  4069. . . .    2\
  4070. . . .    . . .    3'.
  4071.     self
  4072.         comment: ["A tree not defining a superTree pointer is its own root."]
  4073.         test: 
  4074.             [| t |
  4075.             t := SKVTreeLW leafFromPath: #(1 2 3 ).
  4076.             t root]
  4077.         expectResult: '
  4078. 3'!
  4079.  
  4080. rootlessPathNodes
  4081.     self
  4082.         comment: ["You may access the nodes along a rootless path, returning a 
  4083.             collection of nodes."]
  4084.         test: 
  4085.             [| t |
  4086.             t := SKPVTreeLW leafFromPath: #(1 2 3 ).
  4087.             t rootlessPathNodes]
  4088.         expectResult: '#(
  4089. 2\
  4090. . . .    3 
  4091. 3 )'! !
  4092.  
  4093. !TesterTreeLW methodsFor: 'copying'!
  4094.  
  4095. copy
  4096.     "Already tested by the <recursiveCopy> method."!
  4097.  
  4098. recursiveCopy
  4099.     self
  4100.         comment: ["All the subtrees get copied, so the original and the copy have no 
  4101.             identical tree in common."]
  4102.         test: 
  4103.             [| t u v |
  4104.             t := SKPVTreeLW key: 1.
  4105.             t addPath: #(2 3 4 ); addPath: #(5 6 ).
  4106.             u := t recursiveCopy.
  4107.             v := false.
  4108.             t recursiveDo: [:tree1 | u recursiveDo: [:tree2 | tree1 == tree2 ifTrue: [v := true]]].
  4109.             Array with: t with: u with: v]
  4110.         expectResult: '#(
  4111. 1\
  4112. . . .    2\
  4113. . . .    . . .    3\
  4114. . . .    . . .    . . .    4
  4115. . . .    5\
  4116. . . .    . . .    6 
  4117. 1\
  4118. . . .    2\
  4119. . . .    . . .    3\
  4120. . . .    . . .    . . .    4
  4121. . . .    5\
  4122. . . .    . . .    6 false )'! !
  4123.  
  4124. !TesterTreeLW methodsFor: 'testing simple'!
  4125.  
  4126. definesKey
  4127.     self
  4128.         comment: ["This tests whether the instance variable has been defined, not 
  4129.             whether it has been set to some value."]
  4130.         test: [Array with: STreeLW new definesKey with: SKTreeLW new definesKey]
  4131.         expectResult: '#(false true )'!
  4132.  
  4133. definesSubTrees
  4134.     "This is not interesting to test."!
  4135.  
  4136. definesSuperTree
  4137.     self
  4138.         comment: ["This tests whether the instance variable has been defined, not 
  4139.             whether it has been set to some value."]
  4140.         test: [Array with: STreeLW new definesSuperTree with: SPTreeLW new definesSuperTree]
  4141.         expectResult: '#(false true )'!
  4142.  
  4143. definesValue
  4144.     self
  4145.         comment: ["This tests whether the instance variable has been defined, not 
  4146.             whether it has been set to some value."]
  4147.         test: [Array with: STreeLW new definesValue with: SVTreeLW new definesValue]
  4148.         expectResult: '#(false true )'! !
  4149.  
  4150. !TesterTreeLW methodsFor: 'testing misc'!
  4151.  
  4152. belongsTo: aTree 
  4153.     self
  4154.         comment: ["This is of interest for trees defining a superTree pointer."]
  4155.         test: 
  4156.             [| t u v |
  4157.             t := SPTreeLW new.
  4158.             u := SPTreeLW new.
  4159.             v := SPTreeLW new.
  4160.             t add: u.
  4161.             u add: v.
  4162.             Array
  4163.                 with: (u belongsTo: t)
  4164.                 with: (v belongsTo: t)
  4165.                 with: (u belongsTo: u)
  4166.                 with: (t belongsTo: u)]
  4167.         expectResult: '#(true false false false )'.
  4168.     self
  4169.         comment: ["This is always false for trees not defining a superTree pointer."]
  4170.         test: 
  4171.             [| t u v |
  4172.             t := STreeLW new.
  4173.             u := STreeLW new.
  4174.             v := STreeLW new.
  4175.             t add: u.
  4176.             u add: v.
  4177.             Array
  4178.                 with: (u belongsTo: t)
  4179.                 with: (v belongsTo: t)
  4180.                 with: (u belongsTo: u)
  4181.                 with: (t belongsTo: u)]
  4182.         expectResult: '#(false false false false )'!
  4183.  
  4184. hasSubTrees
  4185.     self
  4186.         comment: ["The root has a subtree; the leaf does not."]
  4187.         test: [Array
  4188.                     with: (SKPVTreeLW rootFromPath: #(1 2 )) hasSubTrees
  4189.                     with: (SKPVTreeLW leafFromPath: #(1 2 )) hasSubTrees]
  4190.         expectResult: '#(true false )'!
  4191.  
  4192. includes: aTree 
  4193.     self
  4194.         comment: ["You can test whether a tree is in the subtrees collection."]
  4195.         test: 
  4196.             [| t |
  4197.             t := SKPVTreeLW rootFromPath: #(1 2 ).
  4198.             Array
  4199.                 with: (t includes: (SKPVTreeLW key: 1))
  4200.                 with: (t includes: (SKPVTreeLW key: 2))
  4201.                 with: (t includes: (SKPVTreeLW key: 3))]
  4202.         expectResult: '#(false true false )'!
  4203.  
  4204. includesTreeSatisfying: aBlock 
  4205.     self
  4206.         comment: ["The block should be querying a tree, not a collection."]
  4207.         test: 
  4208.             [| t |
  4209.             t := SKPVTreeLW key: 1.
  4210.             t addKey: 2.
  4211.             t includesTreeSatisfying: [:coll | coll isEmpty]]
  4212.         expectError: 'Message not understood: #isEmpty'.
  4213.     self
  4214.         comment: ["Here's how to test whether a subtree exists satisfying a block."]
  4215.         test: 
  4216.             [| t |
  4217.             t := SKPVTreeLW rootFromPath: #(1 2 ).
  4218.             Array
  4219.                 with: (t includesTreeSatisfying: [:tree | tree key = 1])
  4220.                 with: (t includesTreeSatisfying: [:tree | tree key = 2])
  4221.                 with: (t includesTreeSatisfying: [:tree | tree key = 3])]
  4222.         expectResult: '#(false true false )'!
  4223.  
  4224. isBranch
  4225.     self
  4226.         comment: ["A tree knows whether it is a branch or leaf."]
  4227.         test: [Array
  4228.                     with: SKPVTreeLW new isBranch
  4229.                     with: SKPVTreeLW new makeBranch isBranch]
  4230.         expectResult: '#(false true )'!
  4231.  
  4232. isLeaf
  4233.     "The test for this is in TesterSTreeLW."!
  4234.  
  4235. isProductive
  4236.     self
  4237.         comment: ["Tree t is productive because it has a leaf underneath; u is not 
  4238.             productive."]
  4239.         test: 
  4240.             [| t u |
  4241.             t := SKPVTreeLW rootFromPath: #(1 2 ).
  4242.             u := t recursiveCopy.
  4243.             (u atKey: 2) makeBranch.
  4244.             Array
  4245.                 with: t isProductive
  4246.                 with: u isProductive
  4247.                 with: t
  4248.                 with: u]
  4249.         expectResult: '#(true false 
  4250. 1\
  4251. . . .    2 
  4252. 1\
  4253. . . .    2\ )'!
  4254.  
  4255. isRoot
  4256.     self
  4257.         comment: ["A tree without a superTree pointer is always a root."]
  4258.         test: [Array
  4259.             with: (SKPTreeLW rootFromPath: #(1 2 3 )) isRoot
  4260.             with: (SKPTreeLW leafFromPath: #(1 2 3 )) isRoot
  4261.             with: (SKTreeLW rootFromPath: #(1 2 3 )) isRoot
  4262.             with: (SKTreeLW leafFromPath: #(1 2 3 )) isRoot]
  4263.         expectResult: '#(true false true true )'!
  4264.  
  4265. isTreeLW
  4266.     self
  4267.         comment: ["This test is applicable to any object."]
  4268.         test:
  4269.             [Array
  4270.                 with: Object new isTreeLW
  4271.                 with: SKPVTreeLW new isTreeLW]
  4272.         expectResult: '#(false true )'!
  4273.  
  4274. recursiveBelongsTo: aTree 
  4275.     self
  4276.         comment: ["This is of interest for trees defining a superTree pointer."]
  4277.         test: 
  4278.             [| t u v |
  4279.             t := SPTreeLW new.
  4280.             u := SPTreeLW new.
  4281.             v := SPTreeLW new.
  4282.             t add: u.
  4283.             u add: v.
  4284.             Array
  4285.                 with: (u recursiveBelongsTo: t)
  4286.                 with: (v recursiveBelongsTo: t)
  4287.                 with: (u recursiveBelongsTo: u)
  4288.                 with: (t recursiveBelongsTo: u)]
  4289.         expectResult: '#(true true false false )'.
  4290.     self
  4291.         comment: ["This is always false for trees not defining a superTree pointer."]
  4292.         test: 
  4293.             [| t u v |
  4294.             t := STreeLW new.
  4295.             u := STreeLW new.
  4296.             v := STreeLW new.
  4297.             t add: u.
  4298.             u add: v.
  4299.             Array
  4300.                 with: (u recursiveBelongsTo: t)
  4301.                 with: (v recursiveBelongsTo: t)
  4302.                 with: (u recursiveBelongsTo: u)
  4303.                 with: (t recursiveBelongsTo: u)]
  4304.         expectResult: '#(false false false false )'!
  4305.  
  4306. recursiveIncludes: aTree 
  4307.     self
  4308.         comment: ["You can ask whether a tree includes another tree recursively under it."]
  4309.         test: 
  4310.             [| t |
  4311.             t := SKPVTreeLW rootFromPath: #(1 2 3 ).
  4312.             Array
  4313.                 with: (t recursiveIncludes: (SKPVTreeLW key: 1))
  4314.                 with: (t recursiveIncludes: (SKPVTreeLW key: 2))
  4315.                 with: (t recursiveIncludes: (SKPVTreeLW key: 3))
  4316.                 with: (t recursiveIncludes: (SKPVTreeLW key: 4))]
  4317.         expectResult: '#(false true true false )'!
  4318.  
  4319. recursiveIncludesTreeSatisfying: aBlock 
  4320.     self
  4321.         comment: ["The block should be querying a tree not a collection."]
  4322.         test: 
  4323.             [| t |
  4324.             t := SKPVTreeLW key: 1.
  4325.             t addKey: 2.
  4326.             t recursiveIncludesTreeSatisfying: [:coll | coll isEmpty]]
  4327.         expectError: 'Message not understood: #isEmpty'.
  4328.     self
  4329.         comment: ["Here's how to test for a tree recursively under the receiver."]
  4330.         test: 
  4331.             [| t |
  4332.             t := SKPVTreeLW rootFromPath: #(1 2 3 ).
  4333.             Array
  4334.                 with: (t recursiveIncludesTreeSatisfying: [:tree | tree key = 1])
  4335.                 with: (t recursiveIncludesTreeSatisfying: [:tree | tree key = 2])
  4336.                 with: (t recursiveIncludesTreeSatisfying: [:tree | tree key = 3])
  4337.                 with: (t recursiveIncludesTreeSatisfying: [:tree | tree key = 4])]
  4338.         expectResult: '#(false true true false )'! !
  4339.  
  4340. !TesterTreeLW methodsFor: 'enumerating'!
  4341.  
  4342. collectLW: aBlock 
  4343.     self
  4344.         comment: ["Inappropriate code inside block."]
  4345.         test: 
  4346.             [| t |
  4347.             t := SKPVTreeLW key: 1.
  4348.             t addKeys: #(2 3 ).
  4349.             t collectLW: [:tree | tree sqrt]]
  4350.         expectError: 'Message not understood: #sqrt'.
  4351.     self
  4352.         comment: ["CollectLW: only operates on the immediate subtrees."]
  4353.         test: 
  4354.             [| t u |
  4355.             t := SKPVTreeLW example4: OrderedCollection.
  4356.             u := t collectLW: [:subTree | subTree key: subTree key negated].
  4357.             Array with: t with: u]
  4358.         expectResult: '#(
  4359. 1: a\
  4360. . . .    2: b\
  4361. . . .    . . .    3: c
  4362. . . .    . . .    4: d
  4363. . . .    . . .    5: e
  4364. . . .    6: f 
  4365. 1: a\
  4366. . . .    -2: b\
  4367. . . .    . . .    3: c
  4368. . . .    . . .    4: d
  4369. . . .    . . .    5: e
  4370. . . .    -6: f )'!
  4371.  
  4372. detectLW: aBlock 
  4373.     self
  4374.         comment: ["Detection succeeds with u and fails with v."]
  4375.         test: 
  4376.             [| t u v |
  4377.             t := SKPVTreeLW example4: OrderedCollection.
  4378.             u := t detectLW: [:subTree | subTree key = 2].
  4379.             v := t detectLW: [:subTree | subTree key = 3].
  4380.             Array with: t with: u with: v]
  4381.         expectResult: '#(
  4382. 1: a\
  4383. . . .    2: b\
  4384. . . .    . . .    3: c
  4385. . . .    . . .    4: d
  4386. . . .    . . .    5: e
  4387. . . .    6: f 
  4388. 2: b\
  4389. . . .    3: c
  4390. . . .    4: d
  4391. . . .    5: e nil )'!
  4392.  
  4393. do: aBlock 
  4394.     self
  4395.         comment: ["do: operates on the immediate subtrees."]
  4396.         test: 
  4397.             [| t u |
  4398.             t := SKPVTreeLW example4: OrderedCollection.
  4399.             u := t recursiveCopy do: [:subTree | subTree key: subTree key negated].
  4400.             t simplePrintStringLW , String crLW , u simplePrintStringLW]
  4401.         expectResult: '
  4402. 1: a\
  4403. . . .    2: b\
  4404. . . .    . . .    3: c
  4405. . . .    . . .    4: d
  4406. . . .    . . .    5: e
  4407. . . .    6: f
  4408.  
  4409. 1: a\
  4410. . . .    -2: b\
  4411. . . .    . . .    3: c
  4412. . . .    . . .    4: d
  4413. . . .    . . .    5: e
  4414. . . .    -6: f'!
  4415.  
  4416. do: aBlock inclusive: boolean1 reOrder: boolean2 
  4417.     self
  4418.         comment: ["Notice the difference between specifying true and false and the 
  4419.             effect of using a sorted collection."]
  4420.         test: 
  4421.             [| t u v |
  4422.             t := SKPVTreeLW example4: SortedCollection.
  4423.             u := t recursiveCopy
  4424.                         do: [:subTree | subTree key: subTree key negated]
  4425.                         inclusive: true
  4426.                         reOrder: true.
  4427.             v := t recursiveCopy
  4428.                         do: [:subTree | subTree key: subTree key negated]
  4429.                         inclusive: false
  4430.                         reOrder: false.
  4431.             Array with: t with: u with: v]
  4432.         expectResult: '#(
  4433. 1: a\
  4434. . . .    2: b\
  4435. . . .    . . .    3: c
  4436. . . .    . . .    4: d
  4437. . . .    . . .    5: e
  4438. . . .    6: f 
  4439. -1: a\
  4440. . . .    -6: f
  4441. . . .    -2: b\
  4442. . . .    . . .    3: c
  4443. . . .    . . .    4: d
  4444. . . .    . . .    5: e 
  4445. 1: a\
  4446. . . .    -2: b\
  4447. . . .    . . .    3: c
  4448. . . .    . . .    4: d
  4449. . . .    . . .    5: e
  4450. . . .    -6: f )'!
  4451.  
  4452. inclusiveDo: aBlock 
  4453.     self
  4454.         comment: ["This operates on the receiver and its immediate subtrees; the 
  4455.             subtrees do not get reordered."]
  4456.         test: 
  4457.             [| t u |
  4458.             t := SKPVTreeLW example4: SortedCollection.
  4459.             u := t recursiveCopy inclusiveDo: [:subTree | subTree key: subTree key negated].
  4460.             Array with: t with: u]
  4461.         expectResult: '#(
  4462. 1: a\
  4463. . . .    2: b\
  4464. . . .    . . .    3: c
  4465. . . .    . . .    4: d
  4466. . . .    . . .    5: e
  4467. . . .    6: f 
  4468. -1: a\
  4469. . . .    -2: b\
  4470. . . .    . . .    3: c
  4471. . . .    . . .    4: d
  4472. . . .    . . .    5: e
  4473. . . .    -6: f )'!
  4474.  
  4475. recursiveCollect: aBlock inclusive: boolean 
  4476.     self
  4477.         comment: ["Notice how this recursively operates on all the subtrees and how 
  4478.             they get reordered."]
  4479.         test: 
  4480.             [| t u |
  4481.             t := SKPVTreeLW example4: SortedCollection.
  4482.             u := t recursiveCollect: [:aTree | aTree key: aTree key negated] inclusive: true.
  4483.             Array with: t with: u]
  4484.         expectResult: '#(
  4485. 1: a\
  4486. . . .    2: b\
  4487. . . .    . . .    3: c
  4488. . . .    . . .    4: d
  4489. . . .    . . .    5: e
  4490. . . .    6: f 
  4491. -1: a\
  4492. . . .    -6: f
  4493. . . .    -2: b\
  4494. . . .    . . .    -5: e
  4495. . . .    . . .    -4: d
  4496. . . .    . . .    -3: c )'!
  4497.  
  4498. recursiveDetect: aBlock inclusive: incl topDown: tD breadthFirst: bF 
  4499.     self
  4500.         comment: ["Illustrating the four topDown/bottomUp and breadthFirst/depthFirst 
  4501.             permutations. If you want to see what happens when nothing is 
  4502.             detected, change the test to [:aTree | aTree key = 0]."]
  4503.         test: 
  4504.             [| t s block |
  4505.             t := SKPVTreeLW example3: OrderedCollection.
  4506.             s := WriteStream on: String new.
  4507.             block := 
  4508.                     [:tD1 :bF1 | 
  4509.                     | detectedTree |
  4510.                     detectedTree := t
  4511.                                 recursiveDetect: [:aTree | aTree key odd and: [aTree key > 3]]
  4512.                                 inclusive: true
  4513.                                 topDown: tD1
  4514.                                 breadthFirst: bF1.
  4515.                     s cr; nextPutAll: (tD1
  4516.                             ifTrue: ['topDown ']
  4517.                             ifFalse: ['bottomUp ']); nextPutAll: (bF1
  4518.                             ifTrue: ['breadthFirst ']
  4519.                             ifFalse: ['depthFirst ']); nextPutAll: 'key of detected tree = '; nextPutAll: (detectedTree isTreeLW
  4520.                             ifTrue: [detectedTree key printString]
  4521.                             ifFalse: [detectedTree printString])].
  4522.             block value: true value: true.
  4523.             block value: true value: false.
  4524.             block value: false value: true.
  4525.             block value: false value: false.
  4526.             t simplePrintStringLW , String crLW , s contents]
  4527.         expectResult: '
  4528. 1: a\
  4529. . . .    2: b\
  4530. . . .    . . .    3: c
  4531. . . .    . . .    4: d
  4532. . . .    . . .    5: e
  4533. . . .    6: f
  4534. . . .    7: g\
  4535. . . .    8: h\
  4536. . . .    . . .    9: i
  4537. . . .    . . .    10: j\
  4538. . . .    . . .    . . .    11: k\
  4539. . . .    . . .    . . .    . . .    12: l\
  4540. . . .    . . .    . . .    13: m
  4541.  
  4542. topDown breadthFirst key of detected tree = 7
  4543. topDown depthFirst key of detected tree = 5
  4544. bottomUp breadthFirst key of detected tree = 5
  4545. bottomUp depthFirst key of detected tree = 5'!
  4546.  
  4547. recursiveDo: aBlock 
  4548.     self
  4549.         comment: ["Notice how the subtrees get reordered."]
  4550.         test: 
  4551.             [| t u |
  4552.             t := SKPVTreeLW example4: SortedCollection.
  4553.             u := t recursiveCopy recursiveDo: [:aTree | aTree key: aTree key negated].
  4554.             Array with: t with: u]
  4555.         expectResult: '#(
  4556. 1: a\
  4557. . . .    2: b\
  4558. . . .    . . .    3: c
  4559. . . .    . . .    4: d
  4560. . . .    . . .    5: e
  4561. . . .    6: f 
  4562. -1: a\
  4563. . . .    -6: f
  4564. . . .    -2: b\
  4565. . . .    . . .    -5: e
  4566. . . .    . . .    -4: d
  4567. . . .    . . .    -3: c )'!
  4568.  
  4569. recursiveDo: aBlock inclusive: incl topDown: tD breadthFirst: bF reOrder: reOrder 
  4570.     self
  4571.         comment: ["Notice how the resulting sorted collections of subtrees are not 
  4572.             properly ordered because we did not specify reordering. It should 
  4573.             normally be specified."]
  4574.         test: 
  4575.             [| t u |
  4576.             t := SKPVTreeLW example4: SortedCollection.
  4577.             u := t recursiveCopy
  4578.                         recursiveDo: [:aTree | aTree key: aTree key negated]
  4579.                         inclusive: true
  4580.                         topDown: true
  4581.                         breadthFirst: true
  4582.                         reOrder: false.
  4583.             t simplePrintStringLW , String crLW , u simplePrintStringLW]
  4584.         expectResult: '
  4585. 1: a\
  4586. . . .    2: b\
  4587. . . .    . . .    3: c
  4588. . . .    . . .    4: d
  4589. . . .    . . .    5: e
  4590. . . .    6: f
  4591.  
  4592. -1: a\
  4593. . . .    -2: b\
  4594. . . .    . . .    -3: c
  4595. . . .    . . .    -4: d
  4596. . . .    . . .    -5: e
  4597. . . .    -6: f'.
  4598.     self
  4599.         comment: ["Illustrating the four topDown/bottomUp and breadthFirst/depthFirst permutations."]
  4600.         test: 
  4601.             [| t s block |
  4602.             t := SKPVTreeLW example3: OrderedCollection.
  4603.             s := WriteStream on: String new.
  4604.             block := 
  4605.                     [:tD1 :bF1 | 
  4606.                     s cr; nextPutAll: (tD1
  4607.                             ifTrue: ['topDown ']
  4608.                             ifFalse: ['bottomUp ']); nextPutAll: (bF1
  4609.                             ifTrue: ['breadthFirst ']
  4610.                             ifFalse: ['depthFirst ']); nextPutAll: 'order = '.
  4611.                     t
  4612.                         recursiveDo: [:aTree | s nextPutAll: aTree key printString; space]
  4613.                         inclusive: true
  4614.                         topDown: tD1
  4615.                         breadthFirst: bF1
  4616.                         reOrder: false].
  4617.             block value: true value: true.
  4618.             block value: true value: false.
  4619.             block value: false value: true.
  4620.             block value: false value: false.
  4621.             ' (But see caveat in the actual method.)' printSimplyOnLW: s.
  4622.             t simplePrintStringLW , String crLW , s contents]
  4623.         expectResult: '
  4624. 1: a\
  4625. . . .    2: b\
  4626. . . .    . . .    3: c
  4627. . . .    . . .    4: d
  4628. . . .    . . .    5: e
  4629. . . .    6: f
  4630. . . .    7: g\
  4631. . . .    8: h\
  4632. . . .    . . .    9: i
  4633. . . .    . . .    10: j\
  4634. . . .    . . .    . . .    11: k\
  4635. . . .    . . .    . . .    . . .    12: l\
  4636. . . .    . . .    . . .    13: m
  4637.  
  4638. topDown breadthFirst order = 1 2 6 7 8 3 4 5 9 10 11 13 12 
  4639. topDown depthFirst order = 1 2 3 4 5 6 7 8 9 10 11 12 13 
  4640. bottomUp breadthFirst order = 3 4 5 12 11 13 9 10 2 6 7 8 1 
  4641. bottomUp depthFirst order = 3 4 5 2 6 7 9 12 11 13 10 8 1  (But see caveat in the actual method.)'!
  4642.  
  4643. recursiveSubTrees: inclusiveBoolean 
  4644.     self
  4645.         comment: ["This enumerates the subtrees in a top down, breadth first order."]
  4646.         test: 
  4647.             [| t u |
  4648.             t := SKPVTreeLW example4: SortedCollection.
  4649.             u := (t recursiveSubTrees: true) collect: [:tree | tree key].
  4650.             Array with: u with: t]
  4651.         expectResult: '#(OrderedCollection (1 2 6 3 4 5 ) 
  4652. 1: a\
  4653. . . .    2: b\
  4654. . . .    . . .    3: c
  4655. . . .    . . .    4: d
  4656. . . .    . . .    5: e
  4657. . . .    6: f )'! !
  4658.  
  4659. !TesterTreeLW methodsFor: 'converting'!
  4660.  
  4661. as: treeClass 
  4662.     self
  4663.         comment: ["The class you convert to must be a tree class."]
  4664.         test: [SKPVTreeLW new as: Array]
  4665.         expectError: 'Expecting a tree.'.
  4666.     self
  4667.         comment: ["Both trees must either define a superTree pointer or not define one."]
  4668.         test: [SKTreeLW new as: SKPTreeLW]
  4669.         expectError: 'Attempt to connect incompatible trees.'.
  4670.     self
  4671.         comment: ["This transformation is legal. Notice how the 'value' variable gets discarded."]
  4672.         test: 
  4673.             [| t u |
  4674.             t := SKVTreeLW key: 1 value: 2.
  4675.             u := t as: SKTreeLW.
  4676.             Array with: t with: u]
  4677.         expectResult: '#(
  4678. 1: 2 
  4679. 1 )'!
  4680.  
  4681. recursiveAs: treeClass 
  4682.     self
  4683.         comment: ["Can only convert to another tree this way, not to a collection."]
  4684.         test: [SKPVTreeLW new recursiveAs: Set]
  4685.         expectError: 'Expecting a tree.'.
  4686.     self
  4687.         comment: ["The values of an SKPVTreeLW get lost when it is converted to an 
  4688.             SKTreeLW. Notice how one tree can define a superTree pointer and 
  4689.             the other tree not define it when using recursiveAs:."]
  4690.         test: 
  4691.             [| t u |
  4692.             t := SKVTreeLW
  4693.                         key: 1
  4694.                         value: 11
  4695.                         subTrees: Array.
  4696.             t addAll: (Array with: (SKVTreeLW key: 2 value: 22)
  4697.                     with: (SKVTreeLW key: 3 value: 33)).
  4698.             u := t recursiveAs: SKTreeLW.
  4699.             Array
  4700.                 with: t
  4701.                 with: t class name
  4702.                 with: u
  4703.                 with: u class name]
  4704.         expectResult: '#(
  4705. 1: 11\
  4706. . . .    2: 22
  4707. . . .    3: 33 #SKVTreeLW 
  4708. 1\
  4709. . . .    2
  4710. . . .    3 #SKTreeLW )'! !
  4711.  
  4712. !TesterTreeLW methodsFor: 'printing simple'!
  4713.  
  4714. printOn: aStream 
  4715.     self
  4716.         comment: ["Actually, almost every method ends up testing printOn:. Notice how 
  4717.             branches are marked with a separator suffix."]
  4718.         test: [SKPVTreeLW example4: Array]
  4719.         expectResult: '
  4720. 1: a\
  4721. . . .    2: b\
  4722. . . .    . . .    3: c
  4723. . . .    . . .    4: d
  4724. . . .    . . .    5: e
  4725. . . .    6: f'! !
  4726.  
  4727. !TesterTreeLW methodsFor: 'private initializing'!
  4728.  
  4729. privateInitializing
  4730.     "The methods in the private initializing protocol get tested implicitly whenever a 
  4731.     tree is created in the test suite. Writing explicit tests for them would not be 
  4732.     interesting."! !
  4733.  
  4734. !TesterTreeLW methodsFor: 'private accessing'!
  4735.  
  4736. privateAccessing
  4737.     "The test methods for the private accessing protocol are in the classes which 
  4738.     define the respective instance variables. There are no interesting tests to place 
  4739.     in TesterTreeLW."! !
  4740.  
  4741. !TesterTreeLW methodsFor: 'private printing'!
  4742.  
  4743. privatePrinting
  4744.     "The methods in the private printing protocol get tested implicitly by the 
  4745.     <printOn:> method and whenever a test tree is printed."! !
  4746.  
  4747. !TesterTreeLW methodsFor: 'private validating'!
  4748.  
  4749. privateValidating
  4750.     "The methods in the private validating protocol are implicitly tested by the class 
  4751.     instance creation methods that exercise response to legal and illegal values for 
  4752.     the instance variables. The <validateTree:> and <validateTreeClass:> methods 
  4753.     are implicitly tested by the <as:> method."! !
  4754.  
  4755. !TesterTreeLW methodsFor: 'private misc'!
  4756.  
  4757. privateMisc
  4758.     "The methods in the private misc protocol get tested implicitly by many other 
  4759.     methods in the test suite. Writing explicit tests for them would not be as useful 
  4760.     as proofreading their code."! !
  4761. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4762.  
  4763. TesterTreeLW class
  4764.     instanceVariableNames: ''!
  4765.  
  4766.  
  4767. !TesterTreeLW class methodsFor: 'signal constants'!
  4768.  
  4769. signalConstants
  4770.     "The methods in the signal constants protocol get tested implicitly by other test 
  4771.     methods, mostly in TreeLW, with some in STreeLW and SKTreeLW. All signals 
  4772.     end up getting raised."! !
  4773.  
  4774. !TesterTreeLW class methodsFor: 'instance creation'!
  4775.  
  4776. key: aKey 
  4777.     self
  4778.         comment: ["A nil key is illegal."]
  4779.         test: [SKPVTreeLW key: nil]
  4780.         expectError: 'The key is illegal.'.
  4781.     self
  4782.         comment: ["This is ok."]
  4783.         test: [SKPVTreeLW key: 1]
  4784.         expectResult: '
  4785. 1'!
  4786.  
  4787. key: aKey subTrees: subTreesColl 
  4788.     self
  4789.         comment: ["May specify subtrees along with key."]
  4790.         test: [SKPVTreeLW key: 1 subTrees: (Array with: (SKPVTreeLW key: 2) with: (SKPVTreeLW key: 3))]
  4791.         expectResult: '
  4792. 1\
  4793. . . .    2
  4794. . . .    3'!
  4795.  
  4796. key: aKey value: aValue 
  4797.     self
  4798.         comment: []
  4799.         test: [SKPVTreeLW key: 1 value: 2]
  4800.         expectResult: '
  4801. 1: 2'!
  4802.  
  4803. key: aKey value: aValue subTrees: subTreesColl 
  4804.     self
  4805.         comment: ["May specify subtrees along with key and value."]
  4806.         test: [SKPVTreeLW
  4807.             key: 1
  4808.             value: 11
  4809.             subTrees: (Array with: (SKPVTreeLW key: 2 value: 22) with: (SKPVTreeLW key: 3 value: 33))]
  4810.         expectResult: '
  4811. 1: 11\
  4812. . . .    2: 22
  4813. . . .    3: 33'!
  4814.  
  4815. new
  4816.     "In these tests, trying to instantiate an abstract class leads to an error while 
  4817.     instantiating a concrete class gives a new instance."
  4818.  
  4819.     | abstractClasses concreteClasses |
  4820.     abstractClasses := Array
  4821.                 with: PTreeLW
  4822.                 with: PVTreeLW
  4823.                 with: TreeLW
  4824.                 with: VTreeLW.
  4825.     abstractClasses do: [:aClass | self
  4826.             comment: []
  4827.             test: [aClass new]
  4828.             expectError: 'My subclass should have overridden one of my messages.'].
  4829.  
  4830.     concreteClasses := OrderedCollection new
  4831.                 add: BinaryTreeLW;
  4832.                 add: SKPTreeLW;
  4833.                 add: SKPVTreeLW;
  4834.                 add: SKTreeLW;
  4835.                 add: SKVTreeLW;
  4836.                 add: SPTreeLW;
  4837.                 add: SPVTreeLW;
  4838.                 add: STreeLW;
  4839.                 add: SVTreeLW;
  4840.                 yourself.
  4841.     concreteClasses do: [:aClass | self
  4842.             comment: []
  4843.             test: [aClass new]
  4844.             expectResult: '
  4845. node']!
  4846.  
  4847. subTrees: subTreesColl 
  4848.     "Test several error conditions and then the normal case."
  4849.  
  4850.     self
  4851.         comment: ["Illegal collection class."]
  4852.         test: [SKPVTreeLW subTrees: Dictionary]
  4853.         expectError: 'The subtrees specification is illegal.'.
  4854.     self
  4855.         comment: ["Illegal collection instance."]
  4856.         test: [SKPVTreeLW subTrees: Dictionary new]
  4857.         expectError: 'The subtrees specification is illegal.'.
  4858.     self
  4859.         comment: ["Cannot use a set with STreeLW. This would be legal with SKTreeLW."]
  4860.         test: [STreeLW subTrees: Set]
  4861.         expectError: 'The subtrees specification is illegal.'.
  4862.     self
  4863.         comment: ["Illegal collection instance for STreeLW. This would be legal with SKTreeLW."]
  4864.         test: [STreeLW subTrees: Set new]
  4865.         expectError: 'The subtrees specification is illegal.'.
  4866.     self
  4867.         comment: ["Collection elements must be trees."]
  4868.         test: [SKPVTreeLW subTrees: #(1 2 3)]
  4869.         expectError: 'Expecting a tree.'.
  4870.     self
  4871.         comment: ["One tree has superTree pointer; other doesn't. This is illegal."]
  4872.         test: [SKPVTreeLW subTrees: (Array with: SKVTreeLW new)]
  4873.         expectError: 'Attempt to connect incompatible trees.'.
  4874.     self
  4875.         comment: ["This is ok. Note that no key or value has been specified for the root node."]
  4876.         test: [SKPVTreeLW subTrees: (Array with: (SKPVTreeLW key: 2) with: (SKPVTreeLW key: 3))]
  4877.         expectResult: '
  4878. node\
  4879. . . .    2
  4880. . . .    3'!
  4881.  
  4882. value: aValue
  4883.     self
  4884.         comment: ["A nil value is illegal."]
  4885.         test: [SKPVTreeLW value: nil]
  4886.         expectError: 'The value is illegal.'.
  4887.     self
  4888.         comment: ["This is ok."]
  4889.         test: [SKPVTreeLW value: 1]
  4890.         expectResult: '
  4891. 1'!
  4892.  
  4893. value: aValue subTrees: subTreesColl 
  4894.     self
  4895.         comment: ["May specify subtrees along with value."]
  4896.         test: [SKPVTreeLW value: 1 subTrees: (Array with: (SKPVTreeLW value: 2) with: (SKPVTreeLW value: 3))]
  4897.         expectResult: '
  4898. 1\
  4899. . . .    2
  4900. . . .    3'! !
  4901.  
  4902. TesterForTreesLW subclass: #TesterVTreeLW
  4903.     instanceVariableNames: ''
  4904.     classVariableNames: ''
  4905.     poolDictionaries: ''
  4906.     category: 'Public Domain-Testing-Trees'!
  4907. TesterVTreeLW comment:
  4908. 'Test suite for VTreeLW.'!
  4909.  
  4910.  
  4911. !TesterVTreeLW methodsFor: 'private accessing'!
  4912.  
  4913. basicValue
  4914.     self
  4915.         comment: ["We use SVTreeLW because VTreeLW is an abstract class. Testing 
  4916.             <value> implicitly tests <basicValue>."]
  4917.         test: [(SVTreeLW value: 1) value]
  4918.         expectResult: '1'!
  4919.  
  4920. basicValue: anObject 
  4921.     "The <basicValue:> method is implicitly tested by <basicValue>."! !
  4922. 'Utility methods in lw... protocols used by tree classes and testing classes.'!
  4923.  
  4924. !Array methodsFor: 'lw extensions'!
  4925.  
  4926. addLW: newObject 
  4927.     "Add newObject to the end of the receiver and return newObject. Although the 
  4928.     class comments for Collection and ArrayedCollection prohibit this, there is no 
  4929.     reason in principle for the prohibition. The programmer should be able to make 
  4930.     the following choice: 
  4931.     
  4932.     Array                adding is slow    uses less memory 
  4933.     OrderedCollection    adding is fast    uses more memory 
  4934.     
  4935.     By offering this choice, we extend the polymorphic power of the adding protocol. 
  4936.     We have extended the removing protocol analogously. Since these extensions 
  4937.     are unorthodox, caution is advised in using them. 
  4938.     
  4939.     Implementation note: Although would like to have used copyWith:, it is slower. 
  4940.     More seriously, it returns the species, while we must return the class."
  4941.  
  4942.     | size newSize newArray |
  4943.     newArray := self class new: (newSize := (size := self size) + 1).
  4944.     1 to: size do: [:i | newArray at: i put: (self at: i)].
  4945.     newArray at: newSize put: newObject.
  4946.     self become: newArray.
  4947.     ^newObject!
  4948.  
  4949. remove: oldObject ifAbsentLW: anExceptionBlock 
  4950.     "Remove the first instance of oldObject from the receiver and return oldObject. 
  4951.     If not found, return the result of evaluating anExceptionBlock. Array>>addLW: 
  4952.     explains the rationale for implementing this method. 
  4953.     
  4954.     Implementation note: This method is optimized for speed. A more elegant
  4955.     calculation of newArray runs at less than a third the speed for small arrays: 
  4956.     newArray := ((stream := self readStream) upTo: oldObject) ,, stream upToEnd."
  4957.  
  4958.     | newSize newArray |
  4959.     (newSize := self size - 1) < 0 ifTrue: [^anExceptionBlock value].
  4960.     newArray := self class new: newSize.
  4961.     1 to: newSize do: 
  4962.         [:i | 
  4963.         | element |
  4964.         (element := self at: i) = oldObject
  4965.             ifTrue: 
  4966.                 [i to: newSize do: [:j | newArray at: j put: (self at: j + 1)].
  4967.                 self become: newArray.
  4968.                 ^oldObject]
  4969.             ifFalse: [newArray at: i put: element]].
  4970.     ^(self at: newSize + 1) = oldObject
  4971.         ifTrue: 
  4972.             [self become: newArray.
  4973.             oldObject]
  4974.         ifFalse: [anExceptionBlock value]! !
  4975.  
  4976. !Character methodsFor: 'lw extensions'!
  4977.  
  4978. printSimplyOnLW: aStream  
  4979.     "Append myself to aStream."
  4980.  
  4981.     aStream nextPut: self! !
  4982.  
  4983. !Collection methodsFor: 'lw extensions'!
  4984.  
  4985. addLW: newObject 
  4986.     "Add newObject to the receiver and return newObject. Subclass(es) redefining it 
  4987.     explain its usage."
  4988.  
  4989.     ^self add: newObject!
  4990.  
  4991. anyIncludedInLW: aCollectionEtc
  4992.     "Answer whether any of my elements is included in aCollectionEtc.
  4993.     NOTE: aCollectionEtc can be any object, such as a collection,
  4994.     that responds to the message <includes:>."
  4995.  
  4996.     self do: [:each | (aCollectionEtc includes: each) ifTrue: [^true]].
  4997.     ^false!
  4998.  
  4999. collectLW: aBlock 
  5000.     "Same as collect:. Redefined by subclasses that need to correct 
  5001.     deficiencies in the ParcPlace implementation."
  5002.  
  5003.     ^self collect: aBlock!
  5004.  
  5005. detectLW: aBlock 
  5006.     "Evaluate aBlock with each of the elements of the receiver as the argument.
  5007.     Answer the first element for which aBlock evaluates to true.  If none is found,
  5008.     answer nil.  Same as detect:, except returns nil rather than an error."
  5009.  
  5010.     ^self detect: aBlock ifNone: [nil]!
  5011.  
  5012. elementMatching: anObject ifAbsentLW: aBlock 
  5013.     "Return the first element in the receiver matching anObject, or the result of 
  5014.     evaluating aBlock if none is found. An element is said to match an object if 
  5015.     anElement = anObject."
  5016.  
  5017.     ^self detect: [:anElement | anElement = anObject] ifNone: aBlock!
  5018.  
  5019. isOrderedLW
  5020.     "Is the receiver an OrderedCollection or one of its subclasses?"
  5021.  
  5022.     ^false!
  5023.  
  5024. remove: oldObject ifAbsentLW: anExceptionBlock 
  5025.     "Remove the first instance of oldObject from the receiver and return oldObject. 
  5026.     If not found, return the result of evaluating anExceptionBlock. Subclass(es) 
  5027.     redefining it explain its usage."
  5028.  
  5029.     ^self remove: oldObject ifAbsent: anExceptionBlock!
  5030.  
  5031. removeLW: oldObject 
  5032.     "Remove the first instance of oldObject from the receiver and return oldObject. 
  5033.     If not found, raise an error exception."
  5034.  
  5035.     ^self remove: oldObject ifAbsentLW: [self notFoundError]!
  5036.  
  5037. reOrderLW
  5038.     "Restore the elements of the receiver to their canonical order and return the 
  5039.     receiver. This method is redefined by classes that need to rebuild themselves 
  5040.     after their elements have been modified. For examples, Sets must rehash and 
  5041.     SortedCollections must reSort."! !
  5042.  
  5043. !Collection methodsFor: 'lw polymorphic'!
  5044.  
  5045. as: collectionClass 
  5046.     "Return the result of converting the receiver into an instance of 
  5047.     collectionClass.  We could also have named this asLW: and
  5048.     put it in the lw extensions protocol.  But then we would have
  5049.     wanted to do the same for <TreeLW as:>, which would have
  5050.     been ugly.
  5051.  
  5052.     For example, print the following:"
  5053.  
  5054.     "(Set with: 22/7 with: 3.14 with: Float pi with: Double pi) as: SortedCollection"
  5055.  
  5056.     "For a conversion to be valid, four requirements must 
  5057.     be met. If they are violated, the error will be detected at a lower 
  5058.     level than in this method. If the receiver is unordered, the order
  5059.     of elements in collectionClass will be arbitrary (unless it is a 
  5060.     SortedCollection). 
  5061.     
  5062.     Requirements: 
  5063.     (1) the receiver understands size and do: 
  5064.     (2) collectionClass understands new: 
  5065.     (3) instance of collectionClass understands at:put: or addAll: 
  5066.     (4) instance of collectionClass can store the receiver`s elements 
  5067.     
  5068.     example of receiver        example of            valid/invalid 
  5069.                             collectionClass 
  5070.     
  5071.     Array                    Dictionary            invalid unless elements are associations 
  5072.     Bag                    Set                    valid 
  5073.     Dictionary                OrderedCollection    valid 
  5074.     OrderedCollection        String                invalid unless elements are chars 
  5075.     Set                        Array                valid 
  5076.     SortedCollection        Interval                invalid--Interval rejects at:put: and add: 
  5077.     Set                        Bag                valid
  5078.     String                    Symbol                invalid--Symbol rejects at:put: and add: 
  5079.     Symbol                    SortedCollection    valid"
  5080.  
  5081.     | newCollection |
  5082.     self class = collectionClass ifTrue: [^self copy].
  5083.     newCollection := collectionClass new: self size.
  5084.     (newCollection isSequenceable and: [newCollection isOrderedLW not])
  5085.         ifTrue: 
  5086.             [| i |
  5087.             i := 0.
  5088.             self do: [:element | newCollection at: (i := i + 1) put: element]]
  5089.         ifFalse:
  5090.             [newCollection addAll: self].
  5091.     ^newCollection! !
  5092.  
  5093. !InternalStream methodsFor: 'lw polymorphic'!
  5094.  
  5095. last
  5096.     "Return the last object in the receiver, or nil if it is empty.
  5097.     Used polymorphically, so does not have LW name suffix."
  5098.  
  5099.     ^self isEmpty
  5100.         ifTrue: [nil]
  5101.         ifFalse: [collection at: position]! !
  5102.  
  5103. !Object methodsFor: 'lw extensions'!
  5104.  
  5105. isTreeLW
  5106.     "Return a boolean indicating whether the receiver is a tree."
  5107.  
  5108.     ^false!
  5109.  
  5110. printSimplyOnLW: aStream 
  5111.     "Print a simple representation of the receiver on aStream. This 
  5112.     method provides default behavior and is overridden by classes such 
  5113.     as String and Character whose printOn: methods append extra 
  5114.     characters such as quote or dollar sign."
  5115.  
  5116.     ^self printOn: aStream!
  5117.  
  5118. simplePrintStringLW
  5119.     "Return a simplified print string of the receiver."
  5120.  
  5121.     | aStream |
  5122.     aStream := (String new: 16) writeStream.
  5123.     self printSimplyOnLW: aStream.
  5124.     ^aStream contents! !
  5125.  
  5126. !OrderedCollection class methodsFor: 'lw extensions'!
  5127.  
  5128. filledNewLW: anInteger 
  5129.     "Return a new instance filled with anInteger nil elements. This is distinct from 
  5130.     new:, which returns an empty collection."
  5131.  
  5132.     ^(super new: anInteger) setFilledIndicesLW! !
  5133.  
  5134. !OrderedCollection methodsFor: 'lw extensions'!
  5135.  
  5136. isOrderedLW
  5137.     "Is the receiver an OrderedCollection or one of its subclasses?"
  5138.  
  5139.     ^true!
  5140.  
  5141. setFilledIndicesLW
  5142.     "This is a private method supporting the class method filledNewLW:."
  5143.  
  5144.     firstIndex := 1.
  5145.     lastIndex := self basicSize! !
  5146.  
  5147. !PositionableStream methodsFor: 'lw extensions'!
  5148.  
  5149. upToAfterAnyInLW: aCollectionEtc
  5150.     "Answer a subcollection from position to the occurrence (if any,
  5151.     not inclusive) of any object in aCollectionEtc. If not there, answer 
  5152.     everything.  Leave the receiver positioned after aCollectionEtc.
  5153.     NOTE: aCollectionEtc can be any object, such as a collection,
  5154.     that responds to the message <includes:>."
  5155.  
  5156.     | newStream element |
  5157.     newStream := (self contentsSpecies new: 64) writeStream.
  5158.     [self atEnd or: [aCollectionEtc includes: (element := self next)]]
  5159.         whileFalse: [newStream nextPut: element].
  5160.     ^newStream contents! !
  5161.  
  5162. !SequenceableCollection class methodsFor: 'lw extensions'!
  5163.  
  5164. filledNewLW: size 
  5165.     "Return a new instance of the specified size filled with default elements. The 
  5166.     new: method does the same except for OrderedCollection and its 
  5167.     subclasses, for which it returns an empty collection."
  5168.  
  5169.     ^self new: size! !
  5170.  
  5171. !SequenceableCollection methodsFor: 'lw binary selectors'!
  5172.  
  5173. ,, aSequenceableCollection 
  5174.     "Answer a copy of the receiver concatenated with the argument, 
  5175.     a SequencableCollection. About 50-60% faster than ParcPlace
  5176.     implementation of single comma copy, but at expense of greater
  5177.     complexity."
  5178.  
  5179.     "'' ,, ''"
  5180.     "'hello' ,, ''"
  5181.     "'' ,, ' world'"
  5182.     "'hello' ,, ' world'"
  5183.  
  5184.     | newColl mySize otherSize |
  5185.     newColl := self species filledNewLW: (mySize := self size) + (otherSize := aSequenceableCollection size).
  5186.     self
  5187.         startingAt: 1
  5188.         replaceElementsIn: newColl
  5189.         from: 1
  5190.         to: mySize.
  5191.     aSequenceableCollection
  5192.         startingAt: 1
  5193.         replaceElementsIn: newColl
  5194.         from: mySize + 1
  5195.         to: mySize + otherSize.
  5196.     ^newColl! !
  5197.  
  5198. !SequenceableCollection methodsFor: 'lw extensions'!
  5199.  
  5200. replaceAnyIn: sourceElementCollection withLW: destElement 
  5201.     "Replace all occurrences of any element in sourceElementCollection with 
  5202.     destElement within the receiver."
  5203.  
  5204.     "   '\usr:dict/words' replaceAnyIn: '\:/' withLW: $\   "
  5205.  
  5206.     1 to: self size do: [:i | (sourceElementCollection includes: (self at: i))
  5207.             ifTrue: [self at: i put: destElement]]! !
  5208.  
  5209. !Set methodsFor: 'lw extensions'!
  5210.  
  5211. elementMatching: anObject ifAbsentLW: aBlock 
  5212.     "Return the element in the receiver matching anObject, or the result of 
  5213.     evaluating aBlock if none is found. An element is said to match an object
  5214.     if the following conditions are satisfied: 
  5215.     
  5216.     anElement = anObject 
  5217.     anElement hash = anObject hash 
  5218.     
  5219.     This method uses hashing to speed up the superclass implementation."
  5220.  
  5221.     | index |
  5222.     index := self find: anObject ifAbsent: [^aBlock value].
  5223.     ^self basicAt: index!
  5224.  
  5225. reOrderLW
  5226.     "Restore the elements of the receiver to their canonical order and return the 
  5227.     receiver."
  5228.  
  5229.     self rehash! !
  5230.  
  5231. !SortedCollection methodsFor: 'lw extensions'!
  5232.  
  5233. collectLW: aBlock 
  5234.     "Same as collect:, except returns SortedCollection rather than OrderedCollection 
  5235.     and preserves sort block. It is faster to add all the elements at once rather 
  5236.     than one at a time."
  5237.  
  5238.     | newCollection |
  5239.     newCollection := self species new: self size.    "Cannot use copyEmpty:, because that incorrectly uses class rather than species."
  5240.     newCollection sortBlock: sortBlock.
  5241.     newCollection addAll: (super collect: aBlock).
  5242.     ^newCollection!
  5243.  
  5244. reOrderLW
  5245.     "Restore the elements of the receiver to their canonical order and return the 
  5246.     receiver."
  5247.  
  5248.     self reSort!
  5249.  
  5250. safeAddLastLW: newObject 
  5251.     "This is a private method intended only for use by select:."
  5252.  
  5253.     ^super addLast: newObject! !
  5254.  
  5255. !SortedCollection methodsFor: 'lw polymorphic'!
  5256.  
  5257. select: aBlock 
  5258.     "Same as superclass but optimized under the assumption that since the 
  5259.     receiver and the resulting sorted collection use the same sort block, 
  5260.     elements that pass the selection can be added to the resulting collection 
  5261.     without sorting them. We will ignore pathological sort blocks such as 
  5262.     
  5263.     [:x :y | x <= y & self size odd & Time totalSeconds even] 
  5264.     
  5265.     which violate this assumption, since they appear to be useless.  The
  5266.     assumption is valid for sort blocks that depend only on x and y.
  5267.  
  5268.     Cannot name this selectLW: because we want client methods (senders)
  5269.     to just send select: regardless of the collection class of the receiver."
  5270.  
  5271.     | newCollection |
  5272.     newCollection := self species new: self size.    "Cannot use copyEmpty:, because that incorrectly uses class rather than species."
  5273.     newCollection sortBlock: sortBlock.
  5274.     self do: [:each | (aBlock value: each) ifTrue: [newCollection safeAddLastLW: each]].
  5275.     ^newCollection! !
  5276.  
  5277. !String class methodsFor: 'lw extensions'!
  5278.  
  5279. crLW
  5280.     "Answer a string containing a carriage return."
  5281.  
  5282.     ^self with: Character cr! !
  5283.  
  5284. !String methodsFor: 'lw extensions'!
  5285.  
  5286. crsToSpacesLW
  5287.     "Answer a new string that substitutes spaces for CRs."
  5288.  
  5289.     | cr space |
  5290.     cr := Character cr.
  5291.     space := Character space.
  5292.     ^self collect: [:char | char = cr ifTrue: [space] ifFalse: [char]]!
  5293.  
  5294. prependWith: aChar maxLW: n 
  5295.     "Return a copy of the receiver with enough characters prepended to it to bring its 
  5296.     length up to n."
  5297.  
  5298.     "   '15' prependWith: $0 maxLW: 1"
  5299.     "   '15' prependWith: $0 maxLW: 2"
  5300.     "   '15' prependWith: $0 maxLW: 3"
  5301.  
  5302.     | nChars |
  5303.     nChars := n - self size max: 0.
  5304.     ^(self species new: nChars withAll: aChar) ,, self!
  5305.  
  5306. printSimplyOnLW: aStream 
  5307.     "Append my characters to aStream without performing any special 
  5308.     handling for embedded quotes. Also, do not place quotes before or 
  5309.     after the string."
  5310.  
  5311.     aStream nextPutAll: self!
  5312.  
  5313. simplePrintStringLW
  5314.     "Answer a copy of the receiver. Overrides superclass implementation for 
  5315.     performance."
  5316.  
  5317.     ^self copy! !
  5318.  
  5319.